perlin noise

Programmation d'applications complexes
manababel
Messages : 135
Inscription : jeu. 14/mai/2020 7:40

perlin noise

Message par manababel »

bonjour
voici un générateur de texture.
vous pouvez le trouver à l'adresse ci-dessous la version en PB.
(il est traduit d'un programme écrit en c, mais je ne retrouve plus son adresse.)
https://www.purebasic.fr/english/viewto ... rlin+noise

j'ai juste optimise une partie "3dnoise" du programme en "SSE" (64 bits) et ajoutait le multi thread .par contre j'ai supprimé les procédures "2dnoise" et "1dnoise".
(dls pour ceux qui sont toujours sous Windows 32 bits)

il est bugger en multi thread avec les cos /sin.(voir effet 1) (Problème de synchro peut être ?)

il est facile d'ajouter de nouvelles textures à généré dans la procedure "ShowTurbulence_sp(i)"

Code : Tout sélectionner

CompilerIf #PB_Compiler_Thread = #False
   CompilerError "Enable Thread Safe mode!"
CompilerEndIf

Global ndt_max=CountCPUs(#PB_System_ProcessCPUs )
Global ndt=ndt_max; -1
If ndt < 1 : ndt = 1 :EndIf

Global Dim Thread(ndt_max+1)
Structure var
  cible.i
  start.i
  stop.i
  option.i
  lg.i
  ht.i
  time.f
EndStructure
Global Dim param.var((ndt_max)*2+1)

Global img

Global Dim Tab_Reg(32*128)
Macro Save_reg()
  pointer=@Tab_Reg()
  EnableASM
  !mov rax,[p.v_pointer]
  !mov [rax+00],r8
  !mov [rax+08],r9
  !mov [rax+16],r10
  !mov [rax+24],r11
  !mov [rax+32],r12
  !mov [rax+40],r13
  !mov [rax+48],r14
  !mov [rax+64],r15
  !movdqu [rax+96],xmm4
  !movdqa [rax+112],xmm5
  !movdqa [rax+128],xmm6
  !movdqa [rax+144],xmm7
  !movdqa [rax+160],xmm8
  !movdqa [rax+176],xmm9
  !movdqa [rax+192],xmm10
  !movdqa [rax+208],xmm11
  !movdqa [rax+224],xmm12
  !movdqa [rax+240],xmm13
  DisableASM
EndMacro

Macro rest_Reg()
  pointer=@Tab_Reg()
  EnableASM
  !mov rax,[p.v_pointer]
  !mov r8,[rax+00]
  !mov r9,[rax+08]
  !mov r10,[rax+16]
  !mov r11,[rax+24]
  !mov r12,[rax+32]
  !mov r13,[rax+40]
  !mov r14,[rax+48]
  !mov r15,[rax+64]
  !movdqu xmm4,[rax+96]
  !movdqa xmm5,[rax+112]
  !movdqa xmm6,[rax+128]
  !movdqa xmm7,[rax+144]
  !movdqa xmm8,[rax+160]
  !movdqa xmm9,[rax+176]
  !movdqa xmm10,[rax+192]
  !movdqa xmm11,[rax+208]
  !movdqa xmm12,[rax+224]
  !movdqa xmm13,[rax+240]
   DisableASM
EndMacro

Macro limit(col,pix)
  col = pix
  If pix<0:col=0:EndIf
  If pix>255:col=255:EndIf
EndMacro

#B  = $100
#BM = $ff
#N  = $1000
#NP = 12
#NM = $fff

Macro setupV2(i,b0,b1,r0,r1)
  t  = i + #N
  b0 = Int(t) & #BM
  b1 = (b0 + 1) & #BM
  r0 = t - Int(t)
  r1 = r0 - 1
EndMacro

Declare   init()
Declare.f noise3(x.f, y.f, z.f, alpha.f, beta.f, interations.l)
Declare   normalize3(d.i)
Declare.f PerlinNoise3D(x.f, y.f, z.f, alpha.f, beta.f, n.i);

Global Dim  p.i(#B + #B + 1)
Global Dim g3.f(#B + #B + 4, 3)
Global start.i = 0


Procedure.f noise3(x.f, y.f, z.f, alpha.f, beta.f, interations.l)
  Protected boucle.l
  Protected var.f = 0, sum.f = 0
  Protected scale.f =1
 
  Protected bx0.l, bx1.l, by0.l, by1.l, bz0.l, bz1.l, b00.l, b10.l, b01.l, b11.l
  Protected rx0.f, rx1.f, ry0.f, ry1.f, rz0.f, rz1.f, sy.f, sz.f, a.f , t.f
  Protected i.l, j.l
  Protected q1,q2,q3,q4,q5,q6,q7,q8
 
  g1.f = x : g2.f = y : g3.f = z
  ;Save_reg()
  For boucle = 1 To interations

    setupV2(g1,bx0,bx1,rx0,rx1)
    setupV2(g2,by0,by1,ry0,ry1)
    setupV2(g3,bz0,bz1,rz0,rz1)
   
    i = p( bx0 ) : j = p( bx1 )
    b00 = p( i + by0 ) : b10 = p( j + by0 ) : b01 = p( i + by1 ) : b11 = p( j + by1 )
   
    q1 = @g3( b00 + bz0, 0 )
    q2 = @g3( b10 + bz0, 0 )
    q3 = @g3( b01 + bz0, 0 )
    q4 = @g3( b11 + bz0, 0 )
    q5 = @g3( b00 + bz1, 0 )
    q6 = @g3( b10 + bz1, 0 )   
    q7 = @g3( b01 + bz1, 0 )
    q8 = @g3( b11 + bz1, 0 )
   
    EnableASM
    !mov eax,$7fffffff ; pour ABS
    !movd xmm11,eax
    !mov eax,3
    !movd xmm2,eax ; xmm2 = int(3)
    !cvtdq2ps xmm2,xmm2 ; xmm2 = float(xmm2)
    !VBROADCASTSS xmm2,xmm2 
    ;---------------------------------------------------------------------------------------------------
    ;t  = s_curve(rx0) ; ( t * t * ( 3 - 2 * t ) )
    ;sy = s_curve(ry0)
    ;sz = s_curve(rz0)
    !INSERTPS xmm0,[p.v_rx0],0
    !INSERTPS xmm0,[p.v_ry0],16
    !INSERTPS xmm0,[p.v_rz0],32
    !movups xmm1,xmm0
    !mulps xmm1,xmm1 ; t*t
    !addps xmm0,xmm0 ; t*2 
    !subps xmm2,xmm0 ; 3- t*2 
    !mulps xmm2,xmm1 ; t*t * 3-t*2   
    !VBROADCASTSS xmm9,xmm2
    !INSERTPS xmm10,xmm2,$40
    !VBROADCASTSS xmm10,xmm10
    !EXTRACTPS [p.v_sz],xmm2,2
   ;---------------------------------------------------------------------------------------------------
    !mov r8,[p.v_q1]   ; r8 = q1\d[0] ! q1\d[1] ! q1\d[2]
    !mov r9,[p.v_q2]   ; r9 = q2\d[0] ! q2\d[1] ! q2\d[2]
    !mov r10,[p.v_q3]
    !mov r11,[p.v_q4]
    !mov r12,[p.v_q5] 
    !mov r13,[p.v_q6]
    !mov r14,[p.v_q7]
    !mov r15,[p.v_q8]
   
    !movd xmm1,[p.v_rx0]       
    !INSERTPS xmm1,[p.v_ry0],$10
    !INSERTPS xmm1,[p.v_rz0],$20 ; xmm1 = rz0 ! ry0 ! rx0 
    !movups xmm2,xmm1           
    !INSERTPS xmm2,[p.v_rx1],$00 ; xmm2 = rz0 ! ry0 ! rx1
    !movups xmm3,xmm1           
    !INSERTPS xmm3,[p.v_ry1],$10 ; xmm3 = rz0 ! ry1 ! rx0 
    !movups xmm4,xmm3           
    !INSERTPS xmm4,[p.v_rx1],$00 ; xmm4 = rz0 ! ry1 ! rx1 
    !movups xmm5,xmm1           
    !INSERTPS xmm5,[p.v_rz1],$20 ; xmm5 = rz1 ! ry0 ! rx0   
    !movups xmm6,xmm5           
    !INSERTPS xmm6,[p.v_rx1],$00 ; xmm6 = rz1 ! ry0 ! rx1
    !movups xmm7,xmm5           
    !INSERTPS xmm7,[p.v_ry1],$10 ; xmm7 = rz1 ! ry1 ! rx0
    !movups xmm8,xmm7           
    !INSERTPS xmm8,[p.v_rx1],$00 ; xmm8 = rz1 ! ry1 ! rx1
   
    !mulps xmm1,[r8] ; ( rx0 * *q1\dt[0] + ry0 * *q1\dt[1] + rz0 * *q1\dt[2] )
    !mulps xmm2,[r9]
    !mulps xmm3,[r10]
    !mulps xmm4,[r11]
    !mulps xmm5,[r12]
    !mulps xmm6,[r13]
    !mulps xmm7,[r14]
    !mulps xmm8,[r15]
   
    !haddps xmm1,xmm1
    !haddps xmm2,xmm2
    !haddps xmm3,xmm3
    !haddps xmm4,xmm4
    !haddps xmm5,xmm5
    !haddps xmm6,xmm6
    !haddps xmm7,xmm7
    !haddps xmm8,xmm8
    !haddps xmm1,xmm1 ; u1
    !haddps xmm2,xmm2 ; v1
    !haddps xmm3,xmm3 ; u2
    !haddps xmm4,xmm4 ; v2
    !haddps xmm5,xmm5 ; u3
    !haddps xmm6,xmm6 ; v3
    !haddps xmm7,xmm7 ; u4
    !haddps xmm8,xmm8 ; v4
   
    !INSERTPS xmm1,xmm3,$10 ; xmm1 = u2 ! u1
    !INSERTPS xmm2,xmm4,$10 ; xmm2 = v2 ! v1
    !INSERTPS xmm1,xmm5,$20 ; xmm1 = u3 ! u2 ! u1
    !INSERTPS xmm2,xmm6,$20 ; xmm2 = v3 ! v2 ! v1
    !INSERTPS xmm1,xmm7,$30 ; xmm1 = u4 ! u3 ! u2 ! u1
    !INSERTPS xmm2,xmm8,$30 ; xmm2 = v4 ! v3 ! v2 ! v1
    !subps xmm2,xmm1 ; lerp(t, a, b)
    !mulps xmm2,xmm9
    !addps xmm2,xmm1 ; xmm2 = b2 ! a2 ! b1 ! a1
   
    !INSERTPS xmm1,xmm2,$40 ; xmm1 = .. ! .. ! .. ! b1
    !INSERTPS xmm1,xmm2,$E0 ; xmm1 = .. ! b2 ! .. ! b1
    !subps xmm1,xmm2 ; lerp(t, a, b)
    !mulps xmm1,xmm10
    !addps xmm1,xmm2 ; xmm1 = .  !  d  !  .  !  c
   
    !INSERTPS xmm2,xmm1,$80 ; xmm2 = .  !  .  !  .  !  d
    !subss xmm2,xmm1  ; lerp(sz, c, d)
    !mulss xmm2,[p.v_sz]
    !addss xmm2,xmm1
   
    !andps xmm2,xmm11 ; xmm2 = abs(xmm2)
   
    !movss xmm1,[p.v_scale] ;sum = sum + (a / scale)
    !divss xmm2,xmm1
   
    !addss xmm2,[p.v_sum]
    !movss [p.v_sum],xmm2
    DisableASM

    scale = scale * alpha
    g1 = g1 * beta
    g2 = g2 * beta
    g3 = g3 * beta
  Next
  ;rest_Reg()
ProcedureReturn(sum)

EndProcedure

Procedure init()
  Protected i.i, j.i, k.i, tmp.i

  i = 0
  While i < #B
    p(i)  = i
    For j = 0 To 2
      tmp = ((Random(2147483647) % (#B + #B)) - #B)
      g3(i, j) = tmp / #B
    Next
    i + 1
  Wend

  i - 1
  While i > 0
    i - 1
    k = p(i)
    j = Random(2147483647) % #B
    p(i) = p(j)
    p(j) = k;
  Wend

  i = 0
  While i < #B + 2
    p(#B + i) = p(i)
    For j = 0 To 2
      g3(#B + i, j) = g3(i, j)
    Next
    i + 1
  Wend
EndProcedure


Procedure ShowTurbulence_sp(i)

  cible=param(i)\cible
  start=param(i)\start
  stop=param(i)\stop
  option=param(i)\option
  lg=param(i)\lg
  ht=param(i)\ht
  time.f=param(i)\time
 
  s1.f=0.2:s2.f=0.4:s3.f=0.6
  c1r=206:c1g=103:c1b=0
  c2r=128:c2g=64:c2b=1
  c3r=89:c3g=45:c3b=0
 
  If stop>ht-1 : stop = ht-1 : EndIf

  For y = start To stop
    For x = 0 To  lg-1
     
      px.f = 1 / lg * x
      py.f = 1 / ht * y
      pos =cible + ( y * lg + x)<<2
     
      Select option
        Case 0 ; marbre
          c1_r=0:c1_g=0:c1_b=0
          c2_r=255:c2_g=255:c2_b=255
          pn1.f=Cos(x/30+noise3(px,py,time,5,5,5)*70)
          Limit(b,C1_B*PN1+C2_B*(1-PN1))
          Limit(g,C1_G*PN1+C2_G*(1-PN1))
          Limit(r,C1_R*PN1+C2_R*(1-PN1))
          PokeL(pos, r<<16 + g<<8 + b)
         
        Case 1 ; zebré ; bug en multi-threads
          c1_r=0:c1_g=0:c1_b=0
          c2_r=255:c2_g=255:c2_b=255
          pn1.f=Cos((i/30.0+noise3(px,py,time,5,5,1))*70)
          Limit(b,C1_B*PN1+C2_B*(1-PN1))
          Limit(g,C1_G*PN1+C2_G*(1-PN1))
          Limit(r,C1_R*PN1+C2_R*(1-PN1))
          PokeL(pos, r<<16 + g<<8 + b)
         
        Case 2
          s1.f=0.001:s2.f=0.4:s3.f=0.6
          c1_r=100:c1_g=100:c1_b=200
          c2_r=255:c2_g=255:c2_b=255
          c3_r=100:c3_g=100:c3_b=200
         
          pn.f=noise3(px,py,time,5,5,2);
          If pn<s2
            Limit(b,C1_B*((PN-S1)/(S2-S1))+C2_B*((S2-PN)/(S2-S1)))
            Limit(g,C1_g*((PN-S1)/(S2-S1))+C2_g*((S2-PN)/(S2-S1)))
            Limit(r,C1_r*((PN-S1)/(S2-S1))+C2_r*((S2-PN)/(S2-S1)))
          ElseIf pn<s3
            Limit(b,C2_B*((PN-S2)/(S3-S2))+C3_B*((S3-PN)/(S3-S2)))
            Limit(g,C2_g*((PN-S2)/(S3-S2))+C3_g*((S3-PN)/(S3-S2)))
            Limit(r,C2_r*((PN-S2)/(S3-S2))+C3_r*((S3-PN)/(S3-S2))) 
          Else
            r=c3_r:g=c3_g:b=c3_b
          EndIf
          PokeL(pos, r<<16 + g<<8 + b)
         
        Case 3 ; bois
          s1.f=0.2:s2.f=0.4:s3.f=0.6
          c1_r=206:c1_g=103:c1_b=0
          c2_r=128:c2_g=64:c2_b=0
          c3_r=89:c3_g=45:c3_b=0
         
          T.f=20* noise3(px,py,time,5,1,5);
          pn.f = t - Int(t)
          If pn<s2
            Limit(b,C1_B*((PN-S1)/(S2-S1))+C2_B*((S2-PN)/(S2-S1)))
            Limit(g,C1_g*((PN-S1)/(S2-S1))+C2_g*((S2-PN)/(S2-S1)))
            Limit(r,C1_r*((PN-S1)/(S2-S1))+C2_r*((S2-PN)/(S2-S1)))
          ElseIf pn<s3
            Limit(b,C2_B*((PN-S2)/(S3-S2))+C3_B*((S3-PN)/(S3-S2)))
            Limit(g,C2_g*((PN-S2)/(S3-S2))+C3_g*((S3-PN)/(S3-S2)))
            Limit(r,C2_r*((PN-S2)/(S3-S2))+C3_r*((S3-PN)/(S3-S2))) 
          Else
            r=c3_r:g=c3_g:b=c3_b
          EndIf
          PokeL(pos, r<<16 + g<<8 + b)
         
        Case  4 ; mercure
          s1.f=0.001:s2.f=0.4:s3.f=0.6
          c1_r=81:c1_g=82:c1_b=74
          c2_r=200:c2_g=194:c2_b=193
          c3_r=80:c3_g=80:c3_b=80
          pn=noise3(px,py,time,2,5,2);
          If pn<s2
            Limit(b,C1_B*((PN-S1)/(S2-S1))+C2_B*((S2-PN)/(S2-S1)))
            Limit(g,C1_g*((PN-S1)/(S2-S1))+C2_g*((S2-PN)/(S2-S1)))
            Limit(r,C1_r*((PN-S1)/(S2-S1))+C2_r*((S2-PN)/(S2-S1)))
          ElseIf pn<s3
            Limit(b,C2_B*((PN-S2)/(S3-S2))+C3_B*((S3-PN)/(S3-S2)))
            Limit(g,C2_g*((PN-S2)/(S3-S2))+C3_g*((S3-PN)/(S3-S2)))
            Limit(r,C2_r*((PN-S2)/(S3-S2))+C3_r*((S3-PN)/(S3-S2))) 
          Else
            r=c3_r:g=c3_g:b=c3_b
          EndIf
          PokeL(pos, r<<16 + g<<8 + b)
         
        Case 5 ; feu
          c1_r=192:c1_g=15:c1_b=5
          c2_r=255:c2_g=204:c2_b=0
          pn=noise3(px,py,time,0.5,0.9,5);
          Limit(b,(C1_B*PN)+C2_B*((1-PN)))
          Limit(g,(C1_g*PN)+C2_g*((1-PN)))
          Limit(r,(C1_r*PN)+C2_r*((1-PN)))
          PokeL(pos, r<<16 + g<<8 + b)
         
        Case 6 ; disco
          PN_R.f=noise3(px,py,time  ,2,5,2);
          PN_V.f=noise3(px,py,time+1,2,5,2);
          PN_B.f=noise3(px,py,time+2,2,5,2); 
          r=pn_r*200+100
          g=pn_v*200+50
          b=pn_b*200+50
          PokeL(pos, r<<16 + g<<8 + b)
         
        Case 7
          noise.d = noise3(px, py, time, 2, 2, 6)
          b.i = Int(255* noise) * $10101       
          PokeL(pos, b)
         
        Case 8 ; nuage
          vr.f = noise3(px, py, time/4, 3,2, 6)*0.7
          b=255
          r=(vr*255)*2
          g=(vr*255)*2
          PokeL(pos, r<<16 + g<<8 +b)
          ;Plot(x,y,RGB(c * 255, 55 + c * 200, 255))
         
          Case 9 ; nuage
          vr.f = noise3(px, py, time/2, 2,2, 12)*0.6
          b=255
          r=(vr*255)*2
          g=(vr*255)*2
          PokeL(pos, r<<16 + g<<8 +b)
         
        Case 10
          vr.f = noise3(px, py, time, 2,2, 2)
          vg.f = noise3(px, py, time, 2,2, 2)
          vb.f = noise3(px, py, time, 2,2, 2)
          r=vr*255
          g=vg*255
          b=vb*255
          PokeL(pos, r<<16 + g<<8 +b)
         
        Case 11
          vr.f = noise3(px*15, py*15, time, 5,0.000001, 3)
          r=vr*255
          g=0
          b=0
          PokeL(pos, r<<16 + g<<8 +b)
         
        Case 12
          vr.f = noise3(px*15, py*15, time, 5,0.000001, 3)
          vg.f = noise3(px*30, py*30, time, 2,vr, 2)
          r=vr*255
          b=vg*255
          PokeL(pos, r<<16 + g<<8 +b)
         
        Case 13
          vr.f = noise3(px*5, py*5, time*10, 5,0.000001, 3)
          vg.f = noise3(px*5, py*5, time, 2,vr, 2)
          vb.f = noise3(px*5, py*5, time*5, 2,vg, 1)
          r=vr*300
          g=vg*250
          b=vb*300
          PokeL(pos, r<<16 + g<<8 +b)
         
        Case 14
          vr.f = noise3(px*4+time/10, py*4, time/5, 10,2, 2)
          r=vr*300
          g=vr*300
          b=255
          PokeL(pos, r<<16 + g<<8 +b)
         
      EndSelect   
    Next
  Next
EndProcedure

Procedure.i ShowTurbulence(img,option)
  Static time.f = 0.0
  Protected div , i
 
  StartDrawing(ImageOutput(img))
  cible = DrawingBuffer()
  ht = ImageHeight(img)
  lg = ImageWidth(img)
  StopDrawing()
 
  div=ht/ndt
  For i=0 To ndt
    Param(i)\cible=cible
    Param(i)\option=option
    Param(i)\lg=lg
    Param(i)\ht=ht
    param(i)\time=time
    Param(i)\start=i*div
    Param(i)\stop=(i*div)+div-1
    Thread(i)=CreateThread(@ShowTurbulence_sp(),i)
  Next
 
  For i=0 To ndt-1
    If Thread(i) : WaitThread(thread(i)):EndIf
  Next
 
  time + 0.02 ; vitesse
 
EndProcedure

#width = 512
#height = 512
OpenWindow(0, 100, 100, #width, #height+25, "Perlin Noise - " + Str(TotalSeconds))
img.i = CreateImage(#PB_Any, #Width, #Height, 32)

ComboBoxGadget(1, 1, 1, 100, 20)
For i=0 To 14 : AddGadgetItem(1, -1, "effet "+Str(i)):Next

ComboBoxGadget(2, 150, 1, 100, 20)
For i=1 To ndt : AddGadgetItem(2, -1, "Nb de threads "+Str(i)):Next

init()
Repeat
  Event = WindowEvent()
  Select event
    Case #PB_Event_CloseWindow
      Quit = 1
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 1
          opt=GetGadgetState(1)
        Case 2
          ndt=GetGadgetState(2)+1
      EndSelect
  EndSelect
 
    starttime = ElapsedMilliseconds()
    ShowTurbulence(img,opt)
    TotalSeconds = (ElapsedMilliseconds() - starttime)
    SetWindowTitle(0, "Perlin Noise - " + Str(TotalSeconds))

    StartDrawing(WindowOutput(0))
    DrawImage(ImageID(img),0,25)
    DrawText(260,1,Str(ndt))
    StopDrawing()

Until Event = #PB_Event_CloseWindow
Dernière modification par manababel le sam. 06/févr./2021 8:53, modifié 1 fois.
Avatar de l’utilisateur
kernadec
Messages : 1594
Inscription : ven. 25/avr./2008 11:14

Re: perlin noise

Message par kernadec »

Salut manababel
Merci pour le partage
j'ai un soucis avec ton code
ligne 140 à 147 ; [ERREUR] Instruction illégale. (exécution de données binaires?)
tour pc i5 Seven sp1 64 PB 5.70 64
Avatar de l’utilisateur
kernadec
Messages : 1594
Inscription : ven. 25/avr./2008 11:14

Re: perlin noise

Message par kernadec »

Encore moi :mrgreen:

comme je vois tu aime le travail sur les images
j'ai une requête pour la communauté. PB
je me demande si tu n'aurais pas dans ton grenier un code
du genre Photoshop qui serait une sélection "lasso" et un vrai Zoom.. :idea:

j 'ai essayer le zoom avec PureBasic en mode récursif c 'est nul :?
la règle c 'est une seule multiplication depuis l'image d'origine
exemple : image d'origine x 2, suivante image d'origine x 4
dans ce mode c'est pas la panacée car il ne faut pas aller trop loin dans les tours.
mais bon pour ma demande, je comprend l’ ampleur de la tache 8O

Cordialement
manababel
Messages : 135
Inscription : jeu. 14/mai/2020 7:40

Re: perlin noise

Message par manababel »

bonjour Kermadec

pour l'erreur "Instruction illégale" me fait penser à une instruction ASM non compatible .
pourtant , le i5 possède les instructions sse4 ?

je n'ai jamais essayé de faire de fonction de type "lasso" .
si c'est juste des polygones simple , c'est peut peut être faisable.
pour les polygones non convexe , c'est plus compliqué.

pour les "zooms" , je m'y étais penché il y a bien longtemps.
aucuns ne donne de résultat net , il faut toujours retoucher la photo.
j’essaierai d'en coder quelques-uns .
Avatar de l’utilisateur
kernadec
Messages : 1594
Inscription : ven. 25/avr./2008 11:14

Re: perlin noise

Message par kernadec »

pour le lasso
j'ai retrouvé un vieux code d' "einander" qui avait commencé cette exercice :?:
voici son code j'en avais un autre de "netmaestro" mais je sais plus ce que j'en ai fait :?

si sa peut aider dans cette démarche
voici son code de 2006 :wink: il manque le copié, coller , sinon ce serait top
Cordialement
ps: j'ai remis un autre code corrigé du gadget list

Code : Tout sélectionner

;Masking irregular shaped regions
;by einander
;PB 4.00 - june 27-2006

Global _MX,_MY,_MK
Global _Drawing,_Pen,_PenRGB,_PenStyle
Global _Canvas, _Img,_ImGad 

Macro MOU ;-MOU
  _MX=WindowMouseX(0) 
  _MY=WindowMouseY(0)     
  _MK=Abs(GetAsyncKeyState_(#VK_LBUTTON) +GetAsyncKeyState_(#VK_RBUTTON)*2+GetAsyncKeyState_(#VK_MBUTTON)*3)/$8000   
EndMacro    

Macro StopDraw  ;- StopDraw
  If _Drawing:StopDrawing():_Drawing=0:EndIf
EndMacro

Macro DelPen ;- DelPen
  If _Pen: DeleteObject_(_Pen) :EndIf
  _Pen=0: _PenRGB=0
EndMacro

Macro Pen(Rim=1, PenRGB=0,style=#PS_SOLID) ;- Pen(Rim=1, PenRGB=0,style=0)
  DelPen
  _Pen=CreatePen_(style,Rim,PenRGB)   
  SelectObject_(_Drawing,_Pen) 
  _PenRGB=PenRGB
  _PenStyle=style
EndMacro

Macro DrawWIN(Win=0)
  StopDraw : _Drawing=StartDrawing(WindowOutput(Win))
EndMacro

Macro DrawIMG(ImgNum=0)
  StopDraw: _Drawing=StartDrawing(ImageOutput(ImgNum)) 
EndMacro

Procedure  GetRGN(*R.RECT)
  Dim LP.POINT(0)
  CopyMemory(*R,@P.POINT,8)
  ClientToScreen_(WindowID(EventWindow()), P ) ;  Upper Left from rect to screen coords
  SetRect_(Clip.RECT,P\x,P\y,P\x+ImageWidth(_Img),P\y+ImageHeight(_Img))
  ClipCursor_(Clip)  
  
  LP(0)\x=_MX:LP(0)\y=_MY
  While _MK=1
    WaitWindowEvent()
    MOU
    If #WM_MOUSEMOVE   
      DrawIMG(_Canvas)
      Count+1 
      ReDim LP.POINT(Count)
      LP(Count)\x=_MX : LP(Count)\y=_MY     
      LineXY(LP(Count-1)\x,LP(Count-1)\y,LP(Count)\x,LP(Count)\y,$FFFFFF-Point(_MX,_MY))      
    EndIf
    DrawWIN()
    SetGadgetState(_ImGad,ImageID(_Canvas))    
  Wend
  DrawIMG(_Canvas)
  InnerRGN= CreatePolygonRgn_(@LP(0),Count,#WINDING)   ; try #ALTERNATE <<<<<<<< 
  GetRgnBox_(InnerRGN,*R)
  Pen(1,#Red,#PS_DOT)
  DrawingMode(4)  ; 1 = filled ;2 xor  ; 3 xor+outlined  ; 4= outlined
  Polygon_(_Drawing,@LP(),Count)  
  DrawWIN(EventWindow())
  SetGadgetState(_ImGad,ImageID(_Canvas))    
  DelPen 
  *R\right+1:*R\bottom+1
  ClipCursor_(0)   
  ProcedureReturn InnerRGN
EndProcedure 

Macro ProcessRegion
  If _MK=1
    If InnerRGN ; if exist InnerRGN
      If   PtInRegion_(InnerRGN,_MX,_MY)
        InvertRgn_(_Drawing,InnerRGN) ; test: process inner region
      Else
        InvertRgn_(_Drawing,OuterRGN)  ; test: process outer region
      EndIf
    Else ; if InnerRGN don't exist, try to create it
      OuterRGN=CreateRectRgn_(Outer\left,Outer\top,Outer\right,Outer\bottom)      
      CopyMemory(@Outer,@R.RECT,16)
      InnerRGN=GetRGN(@R)
      SetWindowTitle(0,"Region at "+Str(R\left)+"  "+Str(R\top)+"  "+Str(R\right)+"  "+Str(R\bottom)+"  -  Left MouseButton to select - Right MouseButton To clean")
      CombineRgn_(OuterRGN,OuterRGN,InnerRGN,#RGN_XOR) ;create outer region
    EndIf
    Repeat : MOU:  Until _MK=0 ; wait for released button
  ElseIf _MK=2                 ; clean all to start again
    SetWindowTitle(0,"Define region" )
    DeleteObject_( InnerRGN )  
    DeleteObject_(OuterRGN)
    InnerRGN=0
    DrawIMG(_Canvas)
    DrawImage(ImageID(_Img),Outer\left,Outer\top)
    DrawWIN(EventWindow())
    SetGadgetState(_ImGad,ImageID(_Canvas))    
  EndIf
EndMacro

;<<<<<<<<<<<<<<<<<< 
If OpenWindow(0,0,0,800,600 ,"Define region",$C80001)
  Wi=WindowWidth(0):He=WindowHeight(0)
  _Canvas=CreateImage(-1,Wi,He,32)   ; full window image
  
  _Img=LoadImage(-1,"c:\PureBasic\Examples\Sources\Data\Geebee2.bmp")  ; your image here <<<<<<<<<<<<<<<<           
  ResizeImage(_Img,300,300)                                            ; comment to keep original size
  
  Outer.RECT\left=100  : Outer\top=100   ; image bounding rect
  Outer\right=Outer\left+ImageWidth(_Img)
  Outer\bottom=Outer\top+ImageHeight(_Img)
  
  _ImGad=ImageGadget(-1,0,0,Wi,He,0) 
  DrawIMG(_Canvas) : Box(0,0,Wi,He,$223344)  ; full background - comment to black
  DrawImage(ImageID(_Img),Outer\left,Outer\top)
  DrawWIN()
  SetGadgetState(_ImGad,ImageID(_Canvas))    
  Repeat : MOU:  Until _MK=0  ; wait for released button
  Repeat 
    MOU 
    EV=WaitWindowEvent() 
    If EV= #WM_KEYDOWN And EventwParam()=27:End:EndIf
    If  PtInRect_(@Outer,_MX|_MY <<32)
      ProcessRegion
    EndIf
  Until EV= #PB_Event_CloseWindow
EndIf
End
Répondre