REM  Donut 2
     REM  Version 1.2 // 16-Mar-2012


     REM
     REM  Disable Escape key
     REM

     
*ESC OFF


     REM
     REM  Select 64-bit floating point mode (double-precision maths)
     REM

     
*FLOAT 64


     M% = 2
     HIMEM = LOMEM + M%*&100000
     HIMEM = (HIMEM + 31) AND -32


     REM
     REM  Set up a simple error handler
     REM

     
ON ERROR OSCLI "REFRESH ON" : CLS : ON : REPORT : PRINT " at line ";ERL : VDU 7 : END


     
REM
     REM  Prevent the program window from being resized by the user
     REM

     
PROCfixWindowSize


     REM
     REM  Select a 640x512 display mode and switch off the flashing cursor
     REM

     
MODE 8
     OFF


     
REM
     REM  Install and initialise GFXLIB and required external modules
     REM

     
INSTALL @lib$ + "GFXLIB2.BBC"
     PROCInitGFXLIB( d{}, 0 )

     INSTALL @lib$ + "GFXLIB_modules\PlotPixelList3"       : PROCInitModule
     INSTALL @lib$ + "GFXLIB_modules\RectangleSolid.BBC"   : PROCInitModule
     INSTALL @lib$ + "GFXLIB_modules\RotatePoints3D_0.BBC" : PROCInitModule
     INSTALL @lib$ + "GFXLIB_modules\PlotTint.BBC"         : PROCInitModule


     REM
     REM  Install and initialise SORTLIB (which will be used to depth-sort the
     REM  'vector balls' according to their Z coordinate)
     REM

     
INSTALL @lib$+"SORTLIB"

     sort% = FN_sortinit(1, 0)



     REM
     REM  Load-in the ball sprite (20x20 GIF)
     REM

     
ballBm% = FNLoadImg( @dir$ + "ball2_20x20.GIF", 0 )


     REM
     REM  Define donut vars
     REM

     
ballsPerRing% = 12
     ringRadius% = 20
     ringDist% = 56
     numRings% = 32
     numBalls% = numRings% *  ballsPerRing%


     REM  Arrays to hold the balls' positions in '3D space'
     
DIM x(numBalls% - 1), y(numBalls% - 1), z(numBalls% - 1)


     REM  Arrays to hold the balls' positions *after* they've been rotated
     
DIM x2(numBalls% - 1), y2(numBalls% - 1), z2(numBalls% - 1)


     REM  Arrays to hold each ball's ``normal vector``
     
DIM nx(numBalls% - 1), ny(numBalls% - 1), nz(numBalls% - 1)


     REM  Arrays to hold each ball's rotated normal vector
     
DIM nx2(numBalls% - 1), ny2(numBalls% - 1), nz2(numBalls% - 1)


     REM
     REM  Define our 'light source' direction vector
     REM

     
DIM light{x, y, z}

     light.x = 20
     light.y = 5
     light.z = -10

     M = SQR(light.x^2 + light.y^2 + light.z^2)

     light.x /= M
     light.y /= M
     light.z /= M


     REM
     REM  Set up a horizontally-scrolling starfield
     REM

     
numStars% = 100

     DIM p{( numStars%-1 ) x, y, rgb%, dx}

     R% = RND(-TIME)

     FOR I% = 0 TO numStars%-1
       col% = 255 * I% / (numStars%-1)
       p{( I% )}.x = 640.0 * RND(1)
       p{( I% )}.y = 48 + (512.0 - 2*48) * RND(1)
       p{( I% )}.rgb% = FNrgb( col%, col%, col% )
       p{( I% )}.dx = 0.5 + 3.5*I%/numStars% - 0.5*RND(1)
     NEXT I%


     REM
     REM  Define our 3D donut object
     REM

     
N% = 0

     FOR T% = 0 TO numRings%-1

       FOR A% = 0 TO ballsPerRing%-1

         x = ringDist% + ringRadius% * SIN( A% * 2*PI/ballsPerRing% )
         y = ringRadius% * COS( A% * 2*PI/ballsPerRing% )
         z = 0.0

         nx = 1.0 * SIN( A% * 2*PI/ballsPerRing% )
         ny = 1.0 * COS( A% * 2*PI/ballsPerRing% )
         nz = 0.0

         PROCrotatePoint( x, y, z,    0, T%*(2*PI/numRings%), 0, x`, y`, z` )

         PROCrotatePoint( nx, ny, nz, 0, T%*(2*PI/numRings%), 0, nx`, ny`, nz` )

         x( N% ) = x`
         y( N% ) = y`
         z( N% ) = z`

         nx( N% ) = nx`
         ny( N% ) = ny`
         nz( N% ) = nz`

         N% += 1

       NEXT A%

     NEXT T%


     a = 2.0 * PI*RND(1) : REM  \
     
b = 2.0 * PI*RND(1) : REM   >---  rotation angles
     
c = 2.0 * PI*RND(1) : REM  /


     REM
     REM  Static vars (A%, B%, C%, etc.,) are slightly faster to access :-)
     REM

     
B% = ballBm%
     D% = d{}
     P% = GFXLIB_PlotTint%
     R% = GFXLIB_RectangleSolid%


     REM
     REM  Disable automatic program window refresh
     REM

     
*REFRESH OFF


     REPEAT


       
REM
       REM  Clear the viewport
       REM

       
SYS GFXLIB_Clr%, d{}, 0


       REM
       REM  Draw stars (four pixels per star)
       REM

       
SYS GFXLIB_PlotPixelList3%, d{}, d.bmBuffAddr%, 640, 512, ^p{(0)}.x, 5, DIM(p{(0)}), numStars%, 0, 0
       SYS GFXLIB_PlotPixelList3%, d{}, d.bmBuffAddr%, 640, 512, ^p{(0)}.x, 5, DIM(p{(0)}), numStars%, 1, 0
       SYS GFXLIB_PlotPixelList3%, d{}, d.bmBuffAddr%, 640, 512, ^p{(0)}.x, 5, DIM(p{(0)}), numStars%, 0, 1
       SYS GFXLIB_PlotPixelList3%, d{}, d.bmBuffAddr%, 640, 512, ^p{(0)}.x, 5, DIM(p{(0)}), numStars%, 1, 1


       REM
       REM  Draw upper and lower blue borders
       REM
       REM  Remember that R% = GFXLIB_RectangleSolid%
       REM

       
FOR Y% = 0 TO 47
         C% = 255*(1 - Y%/47)
         SYS R%, D%, 0, Y%, 640, 1, C%
         SYS R%, D%, 0, 511-Y%, 640, 1, C%
       NEXT


       
REM
       REM  Rotate the 3D positions of the balls
       REM  (and also rotate the normal vectors)
       REM

       
SYS GFXLIB_RotatePoints3D_0%, ^x(0), ^y(0), ^z(0), ^x2(0), ^y2(0), ^z2(0), ^a, ^b, ^c, numBalls%
       SYS GFXLIB_RotatePoints3D_0%, ^nx(0), ^ny(0), ^nz(0), ^nx2(0), ^ny2(0), ^nz2(0), ^a, ^b, ^c, numBalls%


       REM
       REM  Sort the rotated ball positions according to their Z-coordinate
       REM

       
C% = numBalls%
       CALL sort%, z2(0), x2(0), y2(0), nx2(0), ny2(0), nz2(0)


       REM  ===========================
       REM  Draw the depth-sorted balls
       REM  ===========================

       REM
       REM  Reminder:  P% = GFXLIB_Plot%
       REM             D% = d{}
       REM             B% = ballBm%
       REM

       
FOR I%=0 TO numBalls%-1

         REM  Calc. perspective factor
         
z = 280 / (200 + z2(I%))

         REM  Calc. 2D viewport coordinates
         
X% = 304 + x2(I%)*z
         Y% = 240 + y2(I%)*z

         REM  Calc. angle between the ball's normal vector,
         REM  and light source vector
         
l_dot_n = light.x*nx2(I%) + light.y*ny2(I%) + light.z*nz2(I%)

         REM  Plot the ball sprite ('tinting' it white in real-time!)
         
SYS P%, D%, B%, 20, 20, X%, Y%, &FFFFFF, &FF*l_dot_n

       NEXT


       
REM
       REM  Update star positions
       REM

       
FOR I% = 0 TO numStars%-1
         p{( I% )}.x += p{( I% )}.dx
         IF p{( I% )}.x >= 640 THEN
           
p{( I% )}.x = 0.0
           p{( I% )}.y = 48 + (512.0 - 2*48) * RND(1)
         ENDIF
       NEXT


       
REM
       REM  Increment and check the rotation angles
       REM

       
a += 0.0292710182113
       b += 0.0263168891711
       c += 0.0221941538383

       IF a > 2*PI THEN a -= 2*PI
       IF
b > 2*PI THEN b -= 2*PI
       IF
c > 2*PI THEN c -= 2*PI


       
REM
       REM  Update the screen (program window)
       REM

       
PROCdisplay

     UNTIL FALSE


     
DEF PROCrotatePoint( x, y, z, a, b, c, RETURN x`, RETURN y`, RETURN z` )
     LOCAL x1, y1, z1, x2, y2, z2, x3, y3, z3
     LOCAL cosa, cosb, cosc, sina, sinb, sinc

     cosa = COSa
     cosb = COSb
     cosc = COSc
     sina = SINa
     sinb = SINb
     sinc = SINc

     REM X rotation
     
y1 = y*cosa - z*sina
     z1 = y*sina + z*cosa
     x1 = x

     REM Y rotation
     
z2 = z1*cosb - x1*sinb
     x2 = z1*sinb + x1*cosb
     y2 = y1

     REM Z rotation
     
x3 = x2*cosc - y2*sinc
     y3 = x2*sinc + y2*cosc
     z3 = z2

     x` = x3
     y` = y3
     z` = z3
     ENDPROC


     
DEF PROCfixWindowSize
     LOCAL GWL_STYLE, WS_THICKFRAME, WS_MAXIMIZEBOX, ws%
     GWL_STYLE = -16
     WS_THICKFRAME = &40000
     WS_MAXIMIZEBOX = &10000
     SYS "GetWindowLong", @hwnd%, GWL_STYLE TO ws%
     SYS "SetWindowLong", @hwnd%, GWL_STYLE, ws% AND NOT (WS_THICKFRAME+WS_MAXIMIZEBOX)
     ENDPROC