REM  Vector ball sphere


     REM
     REM  Disable ESCAPE key
     REM

     
*ESC OFF


     REM
     REM  Set up a simple error handler
     REM

     
ON ERROR OSCLI "REFRESH ON" : MODE 8 : REPORT : PRINT " at line ";ERL : END


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

     
*FLOAT 64


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

     
SYS "GetWindowLong", @hwnd%, -16 TO S%
     SYS "SetWindowLong", @hwnd%, -16, S% AND NOT &50000
     SYS "SetWindowPos", @hwnd%, 0, 0, 0, 0, 0, 32+7


     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( dispVars{}, 0 )

     INSTALL @lib$ + "GFXLIB_modules\PlotSwapRGB.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 graphics (32x32 pixels, 24bpp) and convert to 32bpp
     REM

     
PROCLoadBMP(  @dir$ + "sphere003_32x32x24.BMP", ball1Bm%, FALSE )
     PROCLoadBMP(  @dir$ + "sphere003_32x32x24.BMP", ball2Bm%, FALSE )
     PROCLoadBMP(  @dir$ + "sphere003_32x32x24.BMP", ball3Bm%, FALSE )



     REM
     REM  For ball2 (which is an identical copy of ball1), the Green and Blue colour channels
     REM  of all ball2's non-black pixels are swapped.  The result is a green ball (whereas the
     REM  original colour was blue).
     REM

     
SYS GFXLIB_SetDispVars%, dispVars{}, ball2Bm%, 32, 32, 0, 0, 32, 32, TRUE
     SYS
GFXLIB_PlotSwapRGB%, dispVars{}, ball2Bm%, 32, 32, 0, 0, 2

     SYS GFXLIB_SetDispVars%, dispVars{}, ball3Bm%, 32, 32, 0, 0, 32, 32, TRUE
     SYS
GFXLIB_PlotSwapRGB%, dispVars{}, ball3Bm%, 32, 32, 0, 0, 1

     SYS GFXLIB_SetDispVars%, dispVars{}, dibs%, 640, 512, 0, 0, 640, 512, TRUE



     
maxNumBalls%  = 1000  : REM  Max. allowed number of balls

     REM  Arrays to hold the ball's position in 3D space
     
DIM x%(maxNumBalls% -1), y%(maxNumBalls% -1), z%(maxNumBalls% -1), bmpAddr%(maxNumBalls% -1)


     REM  Arrays to hold the ball's position in 3D space *after* it's been rotated
     
DIM x2%(maxNumBalls% -1), y2%(maxNumBalls% -1), z2%(maxNumBalls% -1), bmpAddr2%(maxNumBalls% -1)


     REM  Define the 3D sphere object

     
N%=0

     FOR A%=0 TO 11
       FOR T%=1 TO 9

         IF (T% MOD 2)=0 THEN
           
bmpAddr%( N% ) = ball1Bm%
         ELSE
           
bmpAddr%( N% ) = ball2Bm%
         ENDIF

         
x# = 150 * SINRAD( 18 * T% )
         y# = 150 * COSRAD( 18 * T% )
         z# = 0

         PROCrotate( x#, y#, z#, 0, RAD(30*A%), 0, x`#, y`#, z`# )

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

         N% += 1

       NEXT T%
     NEXT A%

     x%(N%)=0 : y%(N%)=150 : z%(N%)=0 : bmpAddr%(N%)=ball3Bm% : N%+=1
     x%(N%)=0 : y%(N%)=-150 : z%(N%)=0 : bmpAddr%(N%)=ball3Bm% : N%+=1

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

     
d# = 2.0 * PI*RND(1) : REM  \
     
e# = 2.0 * PI*RND(1) : REM   >---  colour-change arguments
     
f# = 2.0 * PI*RND(1) : REM  /

     
D% = dispVars{}
     P% = GFXLIB_PlotTint%

     *REFRESH OFF

     REPEAT


       
REM
       REM  Clear the viewport (fill it with slowly changing colour)
       REM

       
bg_R% = 127 + 128*SINd#
       bg_B% = 127 + 128*COSe#
       bg_G% = 127 + 128*SINf#*COSe#
       bgCol% = (bg_R%<<16) + (bg_B%<<8) + bg_G%

       SYS GFXLIB_Clr%, dispVars{}, bgCol%


       REM
       REM  Rotate the 3D positions of the balls
       REM

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

       FOR I%=0 TO N%-1

         x# = x%(I%)
         y# = y%(I%)
         z# = z%(I%)

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

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

         REM Z rotation
         
x2%(I%) = x2#*cosc# - y2#*sinc#
         y2%(I%) = x2#*sinc# + y2#*cosc#
         z2%(I%) = z2#

       NEXT I%


       REM
       REM  Sort the rotated X, Y, Z coordinate arrays according to the Z coordinate
       REM
       REM  (...and don't forget to sort the bitmap addresses too!)
       REM

       
bmpAddr2%() = bmpAddr%()

       C%=N% : CALL sort%, z2%(0), x2%(0), y2%(0), bmpAddr2%(0)


       REM  =======================
       REM  Draw the actual balls
       REM  =======================

       REM
       REM  Reminder:  P% = GFXLIB_PlotColourBlend
       REM             D% = dispVars{}
       REM

       
FOR I%=0 TO N%-1

         REM  Calc. perspective factor
         REM  Note: this could have been pre-calculated :)
         
p# = 680/(600 + z2%(I%))

         REM  Calc. the depth-dependent colour blending factor
         REM  Note:  this also could have been pre-calculated :)
         
B% = 255 * ((160 + z2%(I%))/320)

         REM  Calc. final viewport coordinates
         
X% = 304 + x2%(I%)*p#
         Y% = 240 + y2%(I%)*p#

         REM  Plot the ball sprite
         
SYS P%, D%, bmpAddr2%(I%), 32, 32, X%, Y%, bgCol%, B%

       NEXT


       
REM
       REM  Increment and check the rotation angles
       REM

       
a# += 0.019151433
       b# += 0.016316091
       c# += 0.012194255

       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  Increment and check the colour-change args
       REM

       
d# += 0.002177014
       e# += 0.005089972
       f# += 0.003918256

       IF d# > 2*PI THEN d# -= 2*PI
       IF
e# > 2*PI THEN e# -= 2*PI
       IF
f# > 2*PI THEN f# -= 2*PI


       PROC
display


     UNTIL FALSE



     
DEF PROCrotate( 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