' Rotating (pixel) ball for Rapid-Q by William Yu
' Requires DirectX

$TYPECHECK ON
$INCLUDE "RAPIDQ.INC"

DECLARE SUB DrawPoints (Colour AS INTEGER)
DECLARE SUB SetupBall
DECLARE SUB Rotate
DECLARE SUB DXTimerExpired

CONST Scale = 50    ' x and y are multiplied by scale and divided by distance
CONST Radius = 80   ' mystery constant
CONST Slices = 12   ' number of slices
CONST PPS = 20      ' points per slice
CONST Pi = 3.1415

TYPE PointType
  X(1 TO Slices, 1 TO PPS) AS INTEGER
  Y(1 TO Slices, 1 TO PPS) AS INTEGER
  Z(1 TO Slices, 1 TO PPS) AS INTEGER
END TYPE

DIM Points AS PointType
DIM Ball AS PointType
DIM XAngle AS INTEGER, YAngle AS INTEGER, ZAngle AS INTEGER
DIM SinTable(0 TO 255)  AS INTEGER
DIM CosTable(0 TO 255)  AS INTEGER
DIM Distance AS INTEGER, Dir AS INTEGER
DIM I AS INTEGER

DIM DXTimer AS QDXTimer
    DXTimer.Enabled = True
    DXTimer.Interval = 0
    DXTimer.OnTimer = DXTimerExpired

'-- Initialization

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

  Distance = 100: Dir = -3
  SetupBall
  XAngle = 0
  YAngle = 0
  ZAngle = 0


CREATE Form AS QForm
  Center
  Caption = "Rotating Ball"
  ClientWidth = 320
  ClientHeight = 200
  CREATE DXScreen AS QDXScreen
    Init(320, 200)
    Align = alClient
    'Cursor = crNone              '' Hide Mouse
  END CREATE
  ShowModal
END CREATE

END



SUB DXTimerExpired
    DXScreen.Fill(0)

    Rotate
    DrawPoints(&H00FF00)
    XAngle = XAngle + 3
    YAngle = YAngle + 2
    ZAngle = ZAngle + 1
    Distance = Distance + Dir
    IF XAngle > 250 THEN:      XAngle = 0:    END IF
    IF YAngle > 250 THEN:      YAngle = 0:    END IF
    IF ZAngle > 250 THEN:      ZAngle = 0:    END IF
    IF Distance >= 300 THEN:     Dir = -3:    END IF
    IF Distance <= 30 THEN:       Dir = 2:    END IF

    DXScreen.TextOut(10,10,"FPS: "+STR$(DXTimer.FrameRate), clWhite, -1)
    DXScreen.Flip
END SUB


SUB DrawPoints (Colour AS INTEGER)
  DIM I2 AS INTEGER

  FOR I = 1 TO Slices
    FOR I2 = 1 TO PPS
      IF (Points.Z(I, I2) >= 0) AND (Points.X(I, I2) <= 319) AND _
         (Points.X(I, I2) >= 0) AND (Points.Y(I, I2) >= 0) AND _
         (Points.Y(I, I2) < 199) THEN
           DXScreen.Pixel(Points.X(I, I2), Points.Y(I, I2)) = Colour
      END IF
    NEXT
  NEXT
END SUB

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

'{sets up the ball's data..}
SUB SetupBall ' {set up the points}
 DIM SliceLoop AS INTEGER, PPSLoop AS INTEGER
 DIM Phi! AS SINGLE, Theta! AS SINGLE

  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.Y(SliceLoop, PPSLoop) = INT(Radius * SIN(Phi!) * COS(Theta!))
          Ball.X(SliceLoop, PPSLoop) = INT(Radius * SIN(Phi!) * SIN(Theta!))
          Ball.Z(SliceLoop, PPSLoop) = INT(Radius * COS(Phi!))
      NEXT
 NEXT
END SUB