Flying Donut...

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
Mysoft
Posts: 836
Joined: Jul 28, 2005 13:56
Location: Brazil, Santa Catarina, Indaial (ouch!)
Contact:

Flying Donut...

Post by Mysoft »

so i got some donut algorithm that was doing 3ms per frame in C... for 80x25 resolution... and optimized it
so that here i get 0.1ms for 80x25 (-gen gcc) but then i bumped the resolution to 512x384 and got 2.8ms

and added some shaped animation...

Code: Select all

#define fbc -gen gcc -s gui -fpu sse -asm intel -Wc "-Ofast -march=native -mtune=native"

#include "crt.bi"
#include "fbgfx.bi"

const cWid=640 , cHei=480 'donut size
const cScanline=0         '1 to semi-transparent

const cMidX=cWid\2 , cMidY=cHei\2 
const cBlkW=1 , cBlkH=1 , cShades = 128\2
const cDonW=cWid\3 , cDonH = cHei/2 , cMaxY=cHei-3
const PI2 = ATN(1)*8

static shared as ubyte zBuff(cWid*cHei)=any
dim as long A,B,i,j,ScrWid,ScrHei
dim as double DonutX,DonutY

screeninfo ScrWid,ScrHei
screenres cWid*cBlkW , cHei*cBlkH , 8 , 2 , fb.GFX_SHAPED_WINDOW or fb.GFX_ALWAYS_ON_TOP

' !!! May need that on windows with newer freeebasic version? !!!
' but will break it for oler versions (not sure since when... assuming its the D2D render that breaks that)
rem palette 0,255,0,255

DonutX = (ScrWid\2)-cMidX : DonutY = (ScrHei\2)-cMidY
for N as long = 0 to (cShades*2-1)
  var NN = 32+((N*(255-32))\(cShades*2-1))
  palette 128+N,sqr(NN\2)*24,NN*.80,(NN\(N+1))
next N

const cPrecision = (cWid+cHei)\2
static shared as single _Sin(cPrecision+2) , _Cos(cPrecision+2)
for N as ulong = 0 to cPrecision+2
  _Sin(N) = sin(((N*PI2)/cPrecision))
  _Cos(N) = cos(((N*PI2)/cPrecision))
next N

dim as long AVG
dim as single dZoom = timer

do

  erase zBuff
  
  static as long iPage : iPage xor= 1
  screenset iPage xor 1,iPage
  
  line(cMidX-cMidX\2,cHei\16)-(cMidX+cMidX\2,cHei-cHei\16),0,bf
    
  dim as double TMR = timer
  dim as ubyte ptr pBuff = screenptr
  
  dim as single e=_Sin(A) , g=_Cos(A) , m=_Cos(B) , n=_Sin(B)
  
  'zoom in and bump
  static as long Dist = 5
  if Dist > 5 then
    Dist = 256 - tan(timer-dZoom)*251
    if Dist < 4 then Dist = 4
  else
    Dist = 5
  end if  
  
  for j=0 to cPrecision step 1
    
    dim as single d=_Cos(j) , dg=d*g , de=d*e , dn=d*n
    dim as single f=_Sin(j) , fe=f*e , fg=f*g , fg_5 = fg+Dist
    dim as single h=d+2 , he=h*e , hg=h*g , hm=h*m , hn=h*n
    
    for i=0 to cPrecision+2 step 4
      
      'calc pixel
      dim as single c=_Sin(i) , l=_Cos(i)
      dim as single DD=1/(c*he+fg_5)
      if DD > 1/3 then DD = (DD+1/3)/2
      dim as single t=c*hg-fe
      dim as long x=cMidX+clng(cDonW*DD*(l*hm-t*n)) 
      dim as long y=cMidY+clng(cDonH*DD*(l*hn+t*m))      
      dim as long NN=((cShades*1.1)*((fe-c*dg)*m-c*de-fg-l*dn))
      
      'plot pixel and Z order
      var iC = iif(NN>0,NN+128,128)
      
      'speed up "hack lines"
      static as long ox,oy
      var iZ = clng(DD*64)
      if i then
        while ox<>x orelse oy<>y
          if ox<>x then 
            ox += sgn(x-ox) : var o=ox+cWid*(oy or cScanline)
            if iZ>zBuff(o) then zBuff(o) = iZ : pBuff[o] = iC
          end if
          if oy<>y then 
            oy += sgn(y-oy) : var o=ox+cWid*(oy or cScanline)
            if iZ>zBuff(o) then zBuff(o) = iZ : pBuff[o] = iC
          end if
        wend
      else               
        var o=x+cWid*(y or cScanline) : ox=x : oy=y
        if iZ>zBuff(o) then zBuff(o) = iZ : pBuff[o] = iC
      end if      
      
    next i
    
  next j
  
  var dTMR = timer-TMR 
  if AVG=0 then AVG = dTMR*10000 else AVG = (AVG*31+(dTMR*10000))\32
  
  printf( "Spd: " & AVG\10 & "." & AVG mod 10 & !"ms  \r" )  
    
  TMR = timer-TMR
  static as long iSX=1,iSY=1
  var fSpeed = TMR*(ScrHei/8)
  DonutX += iSX*fSpeed : DonutY += iSY*fSpeed
  dim as long iLeft = (-cWid\3) , iRight  = ((ScrWid-cWid)+(cWid\3))
  dim as long iTop  = (-cHei\5) , iBottom = ((ScrHei-cHei)+(cHei\5))
  if DonutX <= iLeft   then DonutX = iLeft   : iSX = abs(iSX)
  if DonutX >= iRight  then DonutX = iRight  : iSX = -abs(iSX)
  if DonutY <= iTop    then DonutY = iTop    : iSY = abs(iSY)
  if DonutY >= iBottom then DonutY = iBottom : iSY = -abs(iSY)
  Screencontrol(fb.SET_WINDOW_POS,cint(DonutX),cint(DonutY) or 1)
  
  TMR = (timer-dZoom)/2.5
  'rotate donut
  A = culng(TMR*cPrecision) mod cPrecision
  B = culng(TMR*cPrecision/2) mod cPrecision
   
loop until len(inkey)
Last edited by Mysoft on May 09, 2022 23:51, edited 2 times in total.
srvaldez
Posts: 3379
Joined: Sep 25, 2005 21:54

Re: Flying Donut...

Post by srvaldez »

hello Mysoft
you need to change all occurrences of cint to clng to make it 64-bit compatible otherwise it will crash in 64-bit
badidea
Posts: 2591
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Flying Donut...

Post by badidea »

Nice, but also on 32-bit fbc, with -exx, I get a runtime error on some runs:

Code: Select all

Spd: 8.0ms  
Aborting due to runtime error 6 (out of bounds array access) at line 49 of test.bas::()
Which is:

Code: Select all

  dim as single e=_Sin(A) , g=_Cos(A) , m=_Cos(B) , n=_Sin(B)
Mysoft
Posts: 836
Joined: Jul 28, 2005 13:56
Location: Brazil, Santa Catarina, Indaial (ouch!)
Contact:

Re: Flying Donut...

Post by Mysoft »

badidea wrote: May 09, 2022 18:20 Nice, but also on 32-bit fbc, with -exx, I get a runtime error on some runs:

Code: Select all

Spd: 8.0ms  
Aborting due to runtime error 6 (out of bounds array access) at line 49 of test.bas::()
Which is:

Code: Select all

  dim as single e=_Sin(A) , g=_Cos(A) , m=_Cos(B) , n=_Sin(B)
hum.... thats not really possible... because...

Code: Select all

const cPrecision = (cWid+cHei)\2
static shared as single _Sin(cPrecision+2) , _Cos(cPrecision+2)
and...
A = clng(TMR*cPrecision) mod cPrecision
B = clng(TMR*cPrecision/2) mod cPrecision
which limits it to the proper limit... making it impossible to be out of bounds.... so it would require something else to corrupt the memory...
unless maybe... timer became negative for some reason... so changing those to culng() should do better

but i noticed on windows (on newer version since i compiled with 1.01|3) shaped window is broken on newer fbgfx version... as its not using "black" or "color 0" anymore for transparency... and instead is using RGB(255,0,255) like the other color modes... i wonder if its just a D2D target bug...
Mysoft
Posts: 836
Joined: Jul 28, 2005 13:56
Location: Brazil, Santa Catarina, Indaial (ouch!)
Contact:

Re: Flying Donut...

Post by Mysoft »

srvaldez wrote: May 09, 2022 17:50 hello Mysoft
you need to change all occurrences of cint to clng to make it 64-bit compatible otherwise it will crash in 64-bit
hum... i did changed but that shouldnt be possible to crash in 64bit unless theres a bug on 64bit compiler itself... as those are not being used as pointers or indexers... unless the same thing that causes out of bounds (negative number?) is causing the crash for you... so it would be better to have those A/B as "ulng" which would block "mod" from returning negative numbers... (but that was suppose to be impossible to have negative number unless the the timer becomes a negative number which shouldnt be possible...) i will test on my 64bit notebook to see if that would happen there...
UEZ
Posts: 988
Joined: May 05, 2017 19:59
Location: Germany

Re: Flying Donut...

Post by UEZ »

With shading - looks very nice :!:

The performance is < 3 ms with x64 compilation.

Thanks for sharing it.
Mysoft
Posts: 836
Joined: Jul 28, 2005 13:56
Location: Brazil, Santa Catarina, Indaial (ouch!)
Contact:

Re: Flying Donut...

Post by Mysoft »

UEZ wrote: May 10, 2022 10:30 With shading - looks very nice :!:

The performance is < 3 ms with x64 compilation.

Thanks for sharing it.
how much it was with x86 in your OS? its probabily not really much different
because compiler is not doing SSE or AVX (vectored) on their own... i would need to do it manually

but probabily would only worth if the donut would be used with 4k or something... (or a static single fullscreen donut)
however since the goal was to optimize it to port to my COCO-2 0.896mhz ... i didnt went to that way hehe
Mysoft
Posts: 836
Joined: Jul 28, 2005 13:56
Location: Brazil, Santa Catarina, Indaial (ouch!)
Contact:

Re: Flying Donut...

Post by Mysoft »

yeah ok i did tests on latest freebasic on notebook... and there is 2.6ms (minimum) for 32bit and 2.5ms (minimum) for 64bit
both using -gen gcc ofcourse...

also i noticed that i forgot to limit the FPS... so it was taking 100% of a whole core :)
also i noticed that using D2D instead of GDI is way slower (in terms of CPU usage) it was doing 43% cpu usage... and now 33% cpu usage with GDI... so i should change the code to GDI driver on windows instead...

but no crashes... i assume there was something making the timer negative for whatever reason... but using unsigned values so that MOD works the way that AND would is for the best to prevent the spurious crash :)
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Flying Donut...

Post by dodicat »

Jam doughnut.

Code: Select all


#cmdline "-gen gcc -Wc -Ofast"

Type V3
    As Single x,y,z
    As Ulong col
    'As boolean c
    Declare Function norm Byref As v3
    Declare Function length As Single
    Declare Function unit As v3
    #define vct Type<v3>
    #define dot *  
    #define cross ^
End Type

Function V3.norm Byref As v3
      Static As v3 t
      Return t
End Function

Type _float
    As Single x,y,z
    End Type

Type Line
    As v3 v1,v2
End Type

Dim Shared As Any Ptr row
Dim Shared As Long pitch
Dim Shared As Long xres,yres

#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
Operator + (Byref v1 As v3,Byref v2 As v3) As v3
Return vct(v1.x+v2.x,v1.y+v2.y,v1.z+v2.z)
End Operator
Operator -(Byref v1 As v3,Byref v2 As v3) As v3
Return vct(v1.x-v2.x,v1.y-v2.y,v1.z-v2.z)
End Operator
Operator * (Byval f As Single,Byref v1 As v3) As v3
Return vct(f*v1.x,f*v1.y,f*v1.z)
End Operator
Operator * (Byref v1 As v3,Byref v2 As v3) As Single 'dot product
Return v1.x*v2.x+v1.y*v2.y+v1.z*v2.z
End Operator
Operator ^ (Byref v1 As v3,Byref v2 As v3) As v3 'cross product
Return vct(v1.y*v2.z-v2.y*v1.z,-(v1.x*v2.z-v2.x*v1.z),v1.x*v2.y-v2.x*v1.y)
End Operator

Function v3.length As Single
Return Sqr(x*x+y*y+z*z)
End Function

Function v3.unit As v3
    Dim n As Single=length
    If n=0 Then n=1e-20
    Return Type(x/n,y/n,z/n)
End Function

Sub QsortZ(array() As V3,begin As Long,Finish As Ulong)
 Dim As Long i=begin,j=finish
 Dim As V3 x =array(((I+J)\2))
   While I <= J
    While array(I).z > X .z:I+=1:Wend
    While array(J).z < X .z:J-=1:Wend
    If I<=J Then Swap array(I),array(J): I+=1:J-=1
   Wend
 If J >begin Then QsortZ(array(),begin,J)
 If I <Finish Then QsortZ(array(),I,Finish)
End Sub

Function RotateArray(wa() As V3,result() As V3,angle As _float,centre As V3,flag As Long=0,eyepoint As V3=(xres\2,yres\2,600)) As v3
            Dim As Single dx,dy,dz,w
            Dim As Single SinAX=Sin(angle.x)
            Dim As Single SinAY=Sin(angle.y)
            Dim As Single SinAZ=Sin(angle.z)
            Dim As Single CosAX=Cos(angle.x)
            Dim As Single CosAY=Cos(angle.y)
            Dim As Single CosAZ=Cos(angle.z)
            Redim result(Lbound(wa) To Ubound(wa))
            For z As Long=Lbound(wa) To Ubound(wa)
                dx=wa(z).x-centre.x
                dy=wa(z).y-centre.y
                dz=wa(z).z-centre.z
                Result(z).x=((Cosay*Cosaz)*dx+(-Cosax*Sinaz+Sinax*Sinay*Cosaz)*dy+(Sinax*Sinaz+Cosax*Sinay*Cosaz)*dz)+centre.x
                result(z).y=((Cosay*Sinaz)*dx+(Cosax*Cosaz+Sinax*Sinay*Sinaz)*dy+(-Sinax*Cosaz+Cosax*Sinay*Sinaz)*dz)+centre.y
                result(z).z=((-Sinay)*dx+(Sinax*Cosay)*dy+(Cosax*Cosay)*dz)+centre.z
                #macro perspective()
                w = 1 + (result(z).z/eyepoint.z)
                result(z).x = (result(z).x-eyepoint.x)/w+eyepoint.x 
                result(z).y = (result(z).y-eyepoint.y)/w+eyepoint.y 
                result(z).z = (result(z).z-eyepoint.z)/w+eyepoint.z
                #endmacro
                If flag Then: perspective():End If
                result(z).col=wa(z).col
                result(z).norm()=wa(z).norm
            Next z
            Return Type(centre.x,centre.y,centre.z)
End Function
        
Function segdist(l As Line,p As v3,Byref ip As v3=vct(0,0,0),flag As Long=0) As Single
    Dim As Single linelength=(l.v1-l.v2).length
    Dim As Single dist= ((1/linelength)*((l.v1-l.v2) cross (p-l.v1))).length
    Dim As Single lpf=(p-l.v2).length,lps=(p-l.v1).length
    If lps >= lpf Then
        Var temp=Sqr(lps*lps-dist*dist)/linelength
       If flag Then If temp>=1 Then temp=1:dist=lpf
        ip=l.v1+temp*(l.v2-l.v1)
        Return dist
    Else
        Var temp=Sqr(lpf*lpf-dist*dist)/linelength
        If flag Then If temp>=1 Then temp=1:dist=lps
        ip=l.v2+temp*(l.v1-l.v2)
        Return dist
    End If
End Function

#macro build(array)
u=Ubound(a)
Redim Preserve a(1 To u+Ubound(array))
For n As Long=Lbound(array) To Ubound(array)
      a(u+n)=array(n)
Next n
#endmacro

Sub AddARing(a() As V3,sz As Long,centre As V3,rad As Long,smoothness As Long,colour As Ulong)
    Dim As Long num=smoothness
    Const pi=4*Atn(1)
    Dim As Single dd=2*pi*rad/num
    Redim As V3 temp(0):Redim a(0)
    Dim As v3 ip
 Dim As Line L1=Type<Line>((centre.x-dd,centre.y-rad),(centre.x+dd,centre.y-rad))   
 Dim As Long ctr
 Dim As Ulong c
For x As Long=L1.v1.x To L1.v2.x Step 3
    For y As Long=L1.v1.y-sz To L1.v2.y+sz Step 2
        For z As Long=-sz To sz Step 2
            Var v=Type<V3>(x,y,z)
            Var sd=segdist(L1,v,ip)
            If sd>sz Andalso sd<sz+2 Then
                ctr+=1
                Redim Preserve temp(1 To ctr)
                If z >-5 And z<5 Then c=Rgb(200+Rnd*55,0,0) Else c=colour
                if z<-20 then c=rgb(120,70,0) else c=c
                temp(ctr)=vct(x,y,z,c)
                temp(ctr).norm()= (temp(ctr)-ip).unit
            End If
        Next z
    Next y
Next x
Dim As Long u
      build(temp)
 Dim As V3 temp2(Lbound(temp) To Ubound(temp))
            'tube element created
            'now revolve it around a circle, save the points to make a torus
       For z As Long=1 To num/2     
      RotateArray(temp(),temp2(),Type(0,0,z*2*pi/(num/2)),centre)      
          build(temp2) 
      Next z
End Sub

 Function Regulate(Byval MyFps As Long,Byref fps As Long,min As Long=1) As Long
            Static As Double timervalue,_lastsleeptime,t3,frames
            Var t=Timer
            frames+=1
            If (t-t3)>=1 Then t3=t:fps=frames:frames=0
            Var sleeptime=_lastsleeptime+((1/myfps)-T+timervalue)*1000
            If sleeptime<1 Then sleeptime=min
            _lastsleeptime=sleeptime
            timervalue=T
            Return sleeptime
 End Function

Sub box(xx As Long,yy As Long,r As Long,clr As Ulong)
     #define putpixel(_x,_y,colour)    *Cptr(Ulong Ptr,row+ (_y)*pitch+ (_x) Shl 2)  =(colour)
     For x As Long=xx-r To xx+r
         For y As Long=yy-r To yy+r
             putpixel(x,y,clr)
         Next:Next
End Sub

Screen 19,32
Color ,Rgb(0,150,255)
row=Screenptr
Screeninfo xres,yres,,,pitch

Redim  As V3 a(0) 'main  array
Redim As V3 r1(0) 'ring
Dim As v3 light=(0,250,0)
Dim As Long u
Dim As Long smoothing=165
AddARing(r1(),60,Type(xres\2,yres\2,0),150,smoothing,Rgb(250,150,0))
build(r1)

Redim As V3 b(Lbound(a) To Ubound(a)) 'feeder array
Dim As Single ang,rad
Dim As Long fps
Do
    ang+=.1
     RotateArray(a(),b(),Type(ang/24,ang/4,ang/6),Type(xres\2,yres\2,0),1)
     Qsortz(b(),Lbound(b),Ubound(b))
     
    Screenlock
    Cls
    Draw String(10,10),"FPS =" & fps
    For n As Long=Lbound(b) To Ubound(b)
          Dim As v3 d=Type(b(n).x-light.x,b(n).y-light.y,b(n).z-light.z).unit'unit point to light
         Var q=b(n).norm() dot d, dt=map(-1,1,q,1,0)
Var rd=Cast(Ubyte Ptr,@b(n).col)[2]*dt,gr=Cast(Ubyte Ptr,@b(n).col)[1]*dt, bl=Cast(Ubyte Ptr,@b(n).col)[0]*dt
        rad=map(-400,400,b(n).z,3,2)
        box(b(n).x,b(n).y,rad,Rgb(rd,gr,bl))
   Next n
Screenunlock
Sleep regulate(50,fps,0),1
Loop Until Inkey=Chr(27)

 
Last edited by dodicat on May 10, 2022 19:19, edited 1 time in total.
UEZ
Posts: 988
Joined: May 05, 2017 19:59
Location: Germany

Re: Flying Donut...

Post by UEZ »

Mysoft wrote: May 10, 2022 13:19
UEZ wrote: May 10, 2022 10:30 With shading - looks very nice :!:

The performance is < 3 ms with x64 compilation.

Thanks for sharing it.
how much it was with x86 in your OS? its probabily not really much different
because compiler is not doing SSE or AVX (vectored) on their own... i would need to do it manually

but probabily would only worth if the donut would be used with 4k or something... (or a static single fullscreen donut)
however since the goal was to optimize it to port to my COCO-2 0.896mhz ... i didnt went to that way hehe
My CPU: AMD Ryzen 5 PRO Mobile 3500U
OS: Microsoft Windows 10 21H2 x64
x64: ~157 FPS average
x86: ~123 FPS average
Compiler settings: -gen gcc -Wc -Ofast -Wc -march=native -Wc -funroll-loops -Wc -mfpmath=sse

I used this code:

Code: Select all

#define fbc -gen gcc -s gui -fpu sse -asm intel -Wc "-Ofast -march=native -mtune=native"

#include "crt.bi"
#include "fbgfx.bi"

const cWid=640 , cHei=480 'donut size
const cScanline=0         '1 to semi-transparent

const cMidX=cWid\2 , cMidY=cHei\2 
const cBlkW=1 , cBlkH=1 , cShades = 128\2
const cDonW=cWid\3 , cDonH = cHei/2 , cMaxY=cHei-3
const PI2 = ATN(1)*8

static shared as ubyte zBuff(cWid*cHei)=any
dim as long A,B,i,j,ScrWid,ScrHei
dim as double DonutX,DonutY

screeninfo ScrWid,ScrHei
screenres cWid*cBlkW , cHei*cBlkH , 8 , 2 , fb.GFX_SHAPED_WINDOW or fb.GFX_ALWAYS_ON_TOP

' !!! May need that on windows with newer freeebasic version? !!!
' but will break it for oler versions (not sure since when... assuming its the D2D render that breaks that)
rem palette 0,255,0,255

DonutX = (ScrWid\2)-cMidX : DonutY = (ScrHei\2)-cMidY
for N as long = 0 to (cShades*2-1)
  var NN = 32+((N*(255-32))\(cShades*2-1))
  palette 128+N,sqr(NN\2)*24,NN*.80,(NN\(N+1))
next N

const cPrecision = (cWid+cHei)\2
static shared as single _Sin(cPrecision+2) , _Cos(cPrecision+2)
for N as ulong = 0 to cPrecision+2
  _Sin(N) = sin(((N*PI2)/cPrecision))
  _Cos(N) = cos(((N*PI2)/cPrecision))
next N

dim as long AVG, counter = 0
dim as single dZoom = timer

Dim As Ulong iFPS, cfps = 0, c = 1
Dim As Double t = 0, fTimer = Timer, fFPSAvg = 0

do

  erase zBuff
  
  static as long iPage : iPage xor= 1
  screenset iPage xor 1,iPage
  
  line(cMidX-cMidX\2,cHei\16)-(cMidX+cMidX\2,cHei-cHei\16),0,bf
    
  dim as double TMR = timer
  dim as ubyte ptr pBuff = screenptr
  
  dim as single e=_Sin(A) , g=_Cos(A) , m=_Cos(B) , n=_Sin(B)
  
  'zoom in and bump
  static as long Dist = 5
  if Dist > 5 then
    Dist = 256 - tan(timer-dZoom)*251
    if Dist < 4 then Dist = 4
  else
    Dist = 5
  end if  
  
  for j=0 to cPrecision step 1
    
    dim as single d=_Cos(j) , dg=d*g , de=d*e , dn=d*n
    dim as single f=_Sin(j) , fe=f*e , fg=f*g , fg_5 = fg+Dist
    dim as single h=d+2 , he=h*e , hg=h*g , hm=h*m , hn=h*n
    
    for i=0 to cPrecision+2 step 4
      
      'calc pixel
      dim as single c=_Sin(i) , l=_Cos(i)
      dim as single DD=1/(c*he+fg_5)
      if DD > 1/3 then DD = (DD+1/3)/2
      dim as single t=c*hg-fe
      dim as long x=cMidX+clng(cDonW*DD*(l*hm-t*n)) 
      dim as long y=cMidY+clng(cDonH*DD*(l*hn+t*m))      
      dim as long NN=((cShades*1.1)*((fe-c*dg)*m-c*de-fg-l*dn))
      
      'plot pixel and Z order
      var iC = iif(NN>0,NN+128,128)
      
      'speed up "hack lines"
      static as long ox,oy
      var iZ = clng(DD*64)
      if i then
        while ox<>x orelse oy<>y
          if ox<>x then 
            ox += sgn(x-ox) : var o=ox+cWid*(oy or cScanline)
            if iZ>zBuff(o) then zBuff(o) = iZ : pBuff[o] = iC
          end if
          if oy<>y then 
            oy += sgn(y-oy) : var o=ox+cWid*(oy or cScanline)
            if iZ>zBuff(o) then zBuff(o) = iZ : pBuff[o] = iC
          end if
        wend
      else               
        var o=x+cWid*(y or cScanline) : ox=x : oy=y
        if iZ>zBuff(o) then zBuff(o) = iZ : pBuff[o] = iC
      end if      
      
    next i
    
  next j
  
  var dTMR = timer-TMR 
  if AVG=0 then AVG = dTMR*10000 else AVG = (AVG*31+(dTMR*10000))\32
  
  cfps += 1
	If Timer - fTimer > 0.99 Then
		iFPS = cfps
		cfps = 0
		fTimer = Timer
	End If
	
	fFPSAvg += iFPS
  printf( "Spd: " & AVG\10 & "." & AVG mod 10 & "ms / fps: " &  iFPS & " / avg: " & fFPSAvg / c & !" \r" )  
    c += 1
		
  TMR = timer-TMR
  static as long iSX=1,iSY=1
  var fSpeed = TMR*(ScrHei/8)
  DonutX += iSX*fSpeed : DonutY += iSY*fSpeed
  dim as long iLeft = (-cWid\3) , iRight  = ((ScrWid-cWid)+(cWid\3))
  dim as long iTop  = (-cHei\5) , iBottom = ((ScrHei-cHei)+(cHei\5))
  if DonutX <= iLeft   then DonutX = iLeft   : iSX = abs(iSX)
  if DonutX >= iRight  then DonutX = iRight  : iSX = -abs(iSX)
  if DonutY <= iTop    then DonutY = iTop    : iSY = abs(iSY)
  if DonutY >= iBottom then DonutY = iBottom : iSY = -abs(iSY)
  Screencontrol(fb.SET_WINDOW_POS,cint(DonutX),cint(DonutY) or 1)
  
  TMR = (timer-dZoom)/2.5
  'rotate donut
  A = culng(TMR*cPrecision) mod cPrecision
  B = culng(TMR*cPrecision/2) mod cPrecision
   
loop until len(inkey)
@dodicat: looks very delicisious - just missing the chocolate glaze :D
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Flying Donut...

Post by dodicat »

UEZ
Done with chocolate.
Mysoft
Spd: 3.3ms / fps: 170 / avg: 151.6067653276956 - 32 bits
Spd: 3.0ms / fps: 184 / avg: 173.6274388355528 - 64 bits

#cmdline "-gen gcc -fpu sse -asm intel -Wc ""-Ofast -march=native -mtune=native"""

Operating System: Windows 10 Pro 64-bit (10.0, Build 19042) (19041.vb_release.191206-1406)
Language: English (Regional Setting: English)
System Manufacturer: Hewlett-Packard
System Model: HP Compaq 8200 Elite SFF PC
BIOS: Default System BIOS (type: BIOS)
Processor: Intel(R) Core(TM) i5-2320 CPU @ 3.00GHz (4 CPUs), ~3.0GHz
Memory: 8192MB RAM
Available OS Memory: 8080MB RAM
Page File: 3136MB used, 6223MB available
UEZ
Posts: 988
Joined: May 05, 2017 19:59
Location: Germany

Re: Flying Donut...

Post by UEZ »

dodicat wrote: May 10, 2022 19:24 UEZ
Done with chocolate.
Mysoft
Spd: 3.3ms / fps: 170 / avg: 151.6067653276956 - 32 bits
Spd: 3.0ms / fps: 184 / avg: 173.6274388355528 - 64 bits

#cmdline "-gen gcc -fpu sse -asm intel -Wc ""-Ofast -march=native -mtune=native"""

Operating System: Windows 10 Pro 64-bit (10.0, Build 19042) (19041.vb_release.191206-1406)
Language: English (Regional Setting: English)
System Manufacturer: Hewlett-Packard
System Model: HP Compaq 8200 Elite SFF PC
BIOS: Default System BIOS (type: BIOS)
Processor: Intel(R) Core(TM) i5-2320 CPU @ 3.00GHz (4 CPUs), ~3.0GHz
Memory: 8192MB RAM
Available OS Memory: 8080MB RAM
Page File: 3136MB used, 6223MB available
Yum, yum :D

Well done.
Mysoft
Posts: 836
Joined: Jul 28, 2005 13:56
Location: Brazil, Santa Catarina, Indaial (ouch!)
Contact:

Re: Flying Donut...

Post by Mysoft »

yes that was the donut source i optimized ... i was basing the optimization more on dosbox (because optimizations to help with SSE/AVX wouldnt be helpful for that)

but i'm not good with the 3D math... what i wanted to do is to make the draw more linearly... while the original was drawing the elipses with sin/cos and drawing enough pixels to cover the moire pattern... i wanted to do the inverse of going pixel by pixel over an area with inverse math... hoping that maybe i would need to do less multiplications for that... because the target (6809) even the mul would be heavier (and would only be a 8x8 = 16 mul), so yeah on another line i changed this to fixed point... and had to make it not degrade quality even when using 4bit for fixed point precision...

as of current code... you get a probabily good speed up by not using the sin/cos tables if i would go to the SSE/AVX line hehe... but meh need "generic" intrinsics to freebasic :P hehe i think i will try to do a pre/post processors to have support for that...
UEZ
Posts: 988
Joined: May 05, 2017 19:59
Location: Germany

Re: Flying Donut...

Post by UEZ »

I ported the ASCII console version to FB:

Code: Select all

'Ported from https://www.a1k0n.net/2021/01/13/optimizing-donut.html to FB by UEZ build 2022-05-16
#include "crt.bi"

Dim Shared As Double xy(1)

Sub R(tanangle As Double, Byref x As Double, Byref y As Double)
	Dim As Double v = x
	x -= tanangle * y
	y += tanangle * v
	v = (3 - x * x - y * y) / 2
	x *= v
	y *= v
	xy(0) = x
	xy(1) = y
End Sub

Dim As Ubyte b(1760), c(1760)
Dim As Double z(1760)
Dim As Ubyte col(11) = 	{   5,   5,   1,   1,   9,   9,   3,   3,  11,  14,   7,  15}
Dim As String ASCII(11) = {".", ",", "-", "~", ":", ";", "=", "!", "*", "#", "$", "@"}
Dim As Long _x, _y, o, N
Dim As Double cA = 1, sA = 0, cB = 0, sB = 1, sj = 0, cj = 1, si = 0, ci = 1, h = 0, D = 0, t = 0

Do
	Locate 1, 1, 0
	R(0.04, cA, sA)
	cA = xy(0)
	sA = xy(1)
	R(.02, cB, sB)
	cB = xy(0)
	sB = xy(1)
	For k As Long = 0 To 1759
		b(k) = Iif(k Mod 80 = 79, 10, 32)
		z(k) = 0
	Next
	sj = 0
	cj = 1
	For j As Long = 0 To 89
		si = 0
		ci = 1
		For i As Long = 0 To 313
			h = cj + 2
			D = 1 / (si * h * sA + sj * cA + 5)
			t = si * h * cA - sj * sA
			_x = (40 + 30 * D * (ci * h * cB - t * sB))
			_y = (12 + 15 * D * (ci * h * sB + t * cB))
			o = _x + 80 * _y
			N = (8 *((sj * sA - si * cj * cA) * cB - si * cj * sA - sj * cA - ci * cj * sB))
			If (_y < 22 And _y >= 0 And _x >= 0 And _x < 79 And D > z(o)) Then
				z(o) = D
				b(o) = Asc(ASCII(Iif(N > 0, N, 0)))
				c(o) = col(Iif(N > 0, N, 0))
			End If
			R(.02, ci, si)
			ci = xy(0)
			si = xy(1)
		Next
		R(.07, cj, sj)
		cj = xy(0)
		sj = xy(1)
	Next
	For k As Long = 0 To 1759
		'? Chr(b(k));
		Color c(k)
		printf(Chr(b(k)))
	Next
	Sleep(1)
Loop Until Len(Inkey())
It's too slow in the console...
¯\_(ツ)_/¯
Post Reply