'===========================================================================
' Subject: ROTATING SPHERE                   Date: 05-28-96 (10:48)       
' Author:  The ABC Programmer                Code: QB, QBasic, PDS        
' Origin:  Converted from PASCAL Code      Packet: GRAPHICS.ABC
'===========================================================================
'{A little rotating sphere, by Glen Jeh, 8/12/1994, use freely}
'{Try messing with the constants...code is squished a little}
' Converted to BASIC by William Yu (05-28-96)
'
' Uncomment the delay if you compile the program
' The screen updates too fast

DEFINT A-Z
DECLARE SUB DrawPoints (Colour)
DECLARE SUB SetupBall ()
DECLARE SUB Rotate ()

CONST Scale = 50    ' x and y are multiplied by scale and divided by distance
CONST Radius = 80   ' mystery constant
CONST DelayTime = 1 ' Delay(DelayTime) to slow it down..
CONST Slices = 12   ' number of slices
CONST PPS = 20      ' points per slice
CONST Pi = 3.14

TYPE PointType
  X AS INTEGER
  Y AS INTEGER
  Z AS INTEGER
END TYPE

DIM SHARED Points(1 TO Slices, 1 TO PPS) AS PointType
DIM SHARED Ball(1 TO Slices, 1 TO PPS) AS PointType
DIM SHARED XAngle, YAngle, ZAngle
DIM SHARED SinTable(0 TO 255)  AS INTEGER
DIM SHARED CosTable(0 TO 255)  AS INTEGER
DIM SHARED Distance, Dir

  FOR I = 0 TO 255
      SinTable(I) = INT(SIN(2 * Pi / 255 * I) * 128)
      CosTable(I) = INT(COS(2 * Pi / 255 * I) * 128)
  NEXT I
  SCREEN 13

  Distance = 100: Dir = -3
  SetupBall
  XAngle = 0
  YAngle = 0
  ZAngle = 0
  DO
    Rotate
    DrawPoints 10
    XAngle = XAngle + 3
    YAngle = YAngle + 2
    ZAngle = ZAngle + 1
    Distance = Distance + Dir
    IF XAngle > 250 THEN XAngle = 0
    IF YAngle > 250 THEN YAngle = 0
    IF ZAngle > 250 THEN ZAngle = 0
    IF Distance >= 300 THEN Dir = -3
    IF Distance <= 30 THEN Dir = 2
    ' Delay(DelayTime);    {I don't know why this is too fast...}
    ' Try it compiled
    '--------------
    'T! = TIMER
    'DO: LOOP UNTIL TIMER > T! + DelayTime / 10
    '--------------
    WAIT &H3DA, 8
    DrawPoints 0
  LOOP UNTIL INKEY$ <> ""
END

'{mystery procedure}
SUB DrawPoints (Colour)
  FOR I = 1 TO Slices
    FOR I2 = 1 TO PPS
      IF (Points(I, I2).Z >= 0) AND (Points(I, I2).X <= 319) AND (Points(I, I2).X >= 0) AND (Points(I, I2).Y >= 0) AND (Points(I, I2).Y < 199) THEN
        DEF SEG = &HA000
        A! = Points(I, I2).Y * 320! + Points(I, I2).X
        POKE A!, Colour
      END IF
    NEXT I2
  NEXT I
END SUB

SUB Rotate
'UPDATES all (X,Y,Z) coordinates according to XAngle,YAngle,ZAngle
 
  FOR I = 1 TO Slices
    FOR I2 = 1 TO PPS
                     '{rotate on X-axis}
      TempY = (Ball(I, I2).Y * CosTable(XAngle) - Ball(I, I2).Z * SinTable(XAngle)) / 128
      TempZ = (Ball(I, I2).Y * SinTable(XAngle) + Ball(I, I2).Z * CosTable(XAngle)) / 128
                    ' {rotate on y-anis}
      TempX = (Ball(I, I2).X * CosTable(YAngle) - TempZ * SinTable(YAngle)) / 128
      TempZ = (Ball(I, I2).X * SinTable(YAngle) + TempZ * CosTable(YAngle)) / 128
                     '{rotate on z-axis}
      OldTempX = TempX
      TempX = (TempX * CosTable(ZAngle) - TempY * SinTable(ZAngle)) / 128
      TempY = (OldTempX * SinTable(ZAngle) + TempY * CosTable(ZAngle)) / 128
      Points(I, I2).X = (TempX * Scale) / Distance + 320 / 2
      Points(I, I2).Y = (TempY * Scale) / Distance + 200 / 2
      Points(I, I2).Z = TempZ
    NEXT I2
  NEXT I
END SUB

'{sets up the ball's data..}
SUB SetupBall ' {set up the points}
  FOR SliceLoop = 1 TO Slices
      Phi! = Pi / Slices * SliceLoop        ' 0 <= Phi <= Pi
      FOR PPSLoop = 1 TO PPS
          Theta! = 2 * Pi / PPS * PPSLoop   ' 0 <= Theta <= 2*Pi
              '{convert Radius,Thetha,Phi to (x,y,z) coordinates}
          Ball(SliceLoop, PPSLoop).Y = INT(Radius * SIN(Phi!) * COS(Theta!))
          Ball(SliceLoop, PPSLoop).X = INT(Radius * SIN(Phi!) * SIN(Theta!))
          Ball(SliceLoop, PPSLoop).Z = INT(Radius * COS(Phi!))
      NEXT PPSLoop
 NEXT SliceLoop
END SUB