PureBasic Forums - English

Code: Select all

EnableExplicit

Global limit=255,ex=1280,ey=720,     i,x,y,z,b,dx,dy,pass=-1,cpt=4,t
Global.d apx,px, apy,py,ascale,scale

Global Dim pal.l(limit)
Global Dim Bmp.l(ey - 1, ex - 1)

Global ndt=CountCPUs(#PB_System_ProcessCPUs )
Global Dim Thread(ndt)

Procedure ColorBlend(color1.l, color2.l, blend.f)
    Protected r.w,g.w,b.w,a.w
    r=  Red(color1) + (Red(color2)     - Red(color1)) * blend
    g=Green(color1) + (Green(color2) - Green(color1)) * blend
    b= Blue(color1) + (Blue(color2) -   Blue(color1)) * blend
    a=Alpha(color1) + (Alpha(color2) - Alpha(color1)) * blend
    ProcedureReturn  RGBA(r,g,b,a)
EndProcedure

Procedure InitPalette(n=16,Cont=0)
    Protected i,j,c1,c2
    c2=Random($ffffff)
    For j = 0 To limit/n
        If Cont:c1=c2:Else:c1=Random($ffffff):EndIf
        c2=Random($ffffff)
        For i=0 To n-1
            pal(j*n+i) =ColorBlend(c1,c2, i/ n) | $ff000000
        Next
    Next
    pal(limit) = $ff000000
EndProcedure

Procedure mandelbrotx4(a.d,b.d,scale.d,Array col.q(1))
    Protected cp.q,fo.d,add.q,     i,t,c
    Protected infinity.f=4
    Dim tab.d(4)
    cp=limit
    fo=infinity
    add=1
    For i=0 To 3
        tab(i)=a
        a+scale
    Next

    t=@tab()
    c=@col()
    !mov rdx,[p.v_t]
    !VPBROADCASTQ ymm8,[p.v_add] ;1  1  1  1
    !VBROADCASTSD ymm7,[p.v_fo] ; 4  4  4  4
    !vmovupd ymm0,[rdx] ;         a1 a2 a3 a4
    !VBROADCASTSD ymm1,[p.v_b] ;  b  b  b  b
    !vmovupd ymm2,ymm0 ; c=a
    !vmovupd ymm3,ymm1 ; d=b
    !vpxor ymm9,ymm9,ymm9
   
    !xor rax,rax
    !boucle:
   
    !vmovupd ymm4,ymm0
    !vmovupd ymm5,ymm1
    !vmulpd ymm4,ymm4,ymm4 ; aa = a * a
    !vmulpd ymm5,ymm5,ymm5 ; bb = b * b
   
    !vmovupd ymm6,ymm4
    !vaddpd ymm6,ymm6,ymm5
   
    ;If (aa + bb) > 4.0:Goto fin:EndIf
    !vcmpltpd ymm6,ymm6,ymm7
    !vmovmskpd rcx,ymm6
    !vandpd  ymm6,ymm6,ymm8 ; and 1
    !vpaddq ymm9,ymm9,ymm6  ; add 1
    !Or rcx,rcx
    !jz fin
   
    ;x1 = 2 * x0 * x1 + x3
    !vmulpd ymm1,ymm1,ymm0 ; b*a
    !vaddpd ymm1,ymm1,ymm1 ; (a*b)*2
    !vaddpd ymm1,ymm1,ymm3 ; (a*b*2)+d
   
    ;x0 = x4 - x5 + c
    !vmovupd ymm0,ymm4 ; a = aa
    !vsubpd ymm0,ymm0,ymm5 ; a = aa - bb
    !vaddpd ymm0,ymm0,ymm2 ;  a = aa - bb + c
   
    !inc rax
    !cmp rax,[p.v_cp]
    !jb boucle
   
    !fin:
   
    !mov rdx,[p.v_c]
    !vMOVDQU [rdx],ymm9
   
    !VZEROALL
   
EndProcedure

Procedure mandelbrot(num)
    Protected i,j,di,dj,jdeb,jfin  ,x.d,y.d
    Dim col.q(4)
    
    jdeb=ey/ndt*num
    jfin=ey/ndt*(num+1)
    di=pass & 1
    dj=pass >>1
    For j=jdeb+dj To jfin-1 Step 2
        y=py+(j -ey/2)*scale
        x=px+(di-ex/2)*scale
        For i=di To ex-1 Step 8
            mandelbrotx4(x, y,scale*2,col())
            bmp(j,i+0)=pal(col(0))
            bmp(j,i+2)=pal(col(1))
            bmp(j,i+4)=pal(col(2))
            bmp(j,i+6)=pal(col(3))
            x+scale*8
        Next
    Next
EndProcedure

InitSprite()
InitKeyboard()
InitMouse()
OpenWindow(0, 0, 0,ex,ey, " Mandelbrot - Use mouse + wheel - LMB to change colors - [F1] Animation (clic to stop) - [Esc] Quit",#PB_Window_ScreenCentered):OpenWindowedScreen(WindowID(0), 0, 0, ex, ey)
;OpenScreen(ex,ey,32,"")

InitPalette()
scale=2/ey

Structure d3
    x.d
    y.d
    z.d
EndStructure

Define auto=0,n,speed.f=0.01,ncible=-1
Dim cible.d3(100)
Macro defcible(vx,vy,vz)
    ncible+1
    cible(ncible)\x=vx
    cible(ncible)\y=vy
    cible(ncible)\z=vz
EndMacro

defcible(0,0,scale)
defcible(-1.74824670606330,-0.00000929287120,0.0000000000004)
defcible(-1.47371049186618,-0.00118606043680,0.00000000000402)
defcible(-0.10494709460288,0.92785703871758,0.00000000000002)
defcible(-0.17030719754610,-1.04455558192402,0.00000000000002)
defcible(-1.02351647109090,-0.28038897116474,0.000000000000003)
defcible(-1.24608830915113,-0.32550803613228,0.000000000000072)
defcible(-1.25403231646337,0.38483487689992,0.000000000000183)
defcible(-1.24165790231311,0.32354681010716,0.00000000000001)
defcible(0.39271500274068,-0.36734653571715,0.000000000000044)
defcible(-1.48126951978746,-0.00269131747118,0.00000000000004)
defcible(-1.99909584429894,-0.00000007963938,0.00000000000090)
n=Random(ncible,1)
CreateSprite(0,32,32):StartDrawing(SpriteOutput(0)):LineXY(0,15,31,15,$ffffffff):LineXY(15,0,15,31,$ffffffff):StopDrawing()
MouseLocate(ex/2,ey/2)
Repeat  
    WindowEvent()
    ExamineMouse()
    ExamineKeyboard()
    If MouseButton(2):InitPalette():cpt=4:EndIf 
    If MouseButton(3):SetClipboardText("defcible("+StrD(px,14)+","+StrD(py,14)+","+StrD(scale,14)+")"):End:EndIf 
    ascale=scale
    apx=px
    apy=py
    If auto
        If Abs(Log(scale)-Log(cible(n)\z))<0.1:If n:n=0:Else:n=Random(ncible,1):InitPalette():EndIf:Debug n:EndIf
        px+(cible(n)\x-px)*speed*1.1
        py+(cible(n)\y-py)*speed*1.1
        scale+(cible(n)\z-scale)*speed
        If MouseButton(1):auto=0:EndIf
    Else
        x=MouseX()
        y=MouseY()
        scale=scale*(1-0.1*MouseWheel())
        px-(x-ex/2)*(scale-ascale)
        py-(y-ey/2)*(scale-ascale)
        If MouseButton(1):px-MouseDeltaX()*scale:py-MouseDeltaY()*scale:EndIf         
        If KeyboardReleased(#PB_Key_F1):auto=1:scale=cible(n)\z:EndIf
    EndIf
    If ascale<>scale Or apx<>px Or apy<>py:cpt=4:EndIf
    If cpt
        cpt-1
        pass=(pass+1) & 3
;         t=ElapsedMilliseconds()
        For i=0 To ndt-1:Thread(i)=CreateThread(@mandelbrot(),i):Next
        For i=0 To ndt-1:If Thread(i) : WaitThread(thread(i)):EndIf:Next
        ;ndt=1:mandelbrot(0)
        ;t=ElapsedMilliseconds()-t
    EndIf
    StartDrawing(ScreenOutput())
    CopyMemory(@bmp(0,0),DrawingBuffer(),ex*ey*4)
    DrawingMode(#PB_2DDrawing_Transparent )
    DrawText(10,10,"Scale  " + StrD(scale,14))
    DrawText(10,30,"X  "+StrD(px,14))
    DrawText(10,50,"Y  "+StrD(py,14))
    ;DrawText(10,70,Str(t))
    StopDrawing()
    DisplayTransparentSprite(0,x-15,y-15)
    FlipBuffers()
Until KeyboardReleased(#PB_Key_Escape)

Code: Select all

---------------------------
PureBasic - Assembler error
---------------------------
PureBasic.asm [1501]:
mov rdx,[p.v_t]
error: illegal instruction.
---------------------------
OK   
---------------------------