'===========================================================================
' Subject: ROTATING SPHERE OF FIRE           Date: 02-10-97 (19:02)       
' Author:  Angelo Ken Pesce                  Code: QB, QBasic, PDS        
' Origin:  ken@uniserv.uniplan.it          Packet: GRAPHICS.ABC
'===========================================================================
DECLARE SUB ReadRGB (red%, grn%, blu%, slot%)
DECLARE SUB WriteRGB (red%, grn%, blu%, slot%)
DECLARE SUB SetPal (start.slot%, end.slot%)
DECLARE SUB flam ()
'{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)
' Revision + Static FastFireEffect v2 added by Angelo Pesce (1997)
'
' 192 colors version (palette routines by Andrew L. Ayers)
'
' COMPILE WITH ALTERNATE MATH FOR BEST PERFORMANCE

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

PRINT "FireSphere"
PRINT ".........."
PRINT
PRINT "press enter for defaults"
PRINT

' x and y are multiplied by scale and divided by distance
0 DIM SHARED Scale AS INTEGER
INPUT "Scale:"; temp1$
IF temp1$ = "" THEN Scale = 50: GOTO 1
Scale = VAL(temp1$)

' mystery constant :-)
1 DIM SHARED Radius AS INTEGER
INPUT "Radius:"; temp2$
IF temp2$ = "" THEN Radius = 80: GOTO 2
Radius = VAL(temp2$)

' number of slices
2 DIM SHARED Slices AS INTEGER
INPUT "Slices:"; temp3$
IF temp3$ = "" THEN Slices = 24: GOTO 3
Slices = VAL(temp3$)

' points per slice
3 DIM SHARED PPS AS INTEGER
INPUT "Points Per Slice:"; temp4$
IF temp4$ = "" THEN PPS = 40: GOTO 4
PPS = VAL(temp4$)

4 CONST Pi = 3.1415

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

' FORM BLACK TO RED
CALL WriteRGB(0, 0, 0, 1)
CALL WriteRGB(63, 0, 0, 63)
CALL SetPal(1, 63)

' FROM RED TO YELLOW
CALL WriteRGB(63, 0, 0, 64)
CALL WriteRGB(63, 63, 0, 127)
CALL SetPal(64, 127)

' FROM YELLOW TO WHITE
CALL WriteRGB(63, 63, 0, 128)
CALL WriteRGB(63, 63, 63, 191)
CALL SetPal(128, 191)
'
PALETTE 192, 63

 DO
    Rotate
    DrawPoints
    flam
    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
    LOOP UNTIL INKEY$ <> ""
CLS
SCREEN 0
WIDTH 80
PRINT "Angelo KEN Pesce 1997"
END

'{mystery procedure}
SUB DrawPoints
  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
        PSET (points(i, i2).x, points(i, i2).y), 192
      END IF
    NEXT i2
  NEXT i

END SUB

SUB flam
DEF SEG = &HA000
FOR yp = 0 TO 100
FOR xp = 0 TO 319
col = PEEK(yp * 320 + xp)
col = col + PEEK(yp * 320 + (xp - 1))
' ************** BLACK JUMP ROUTINE **************************
IF col = 0 THEN GOTO fastout: ' BLACK JUMP
' ************************************************************
col = col + PEEK((yp - 1) * 320 + xp)
col = col + PEEK((yp + 1) * 320 + xp)
col = col + PEEK(yp * 320 + (xp + 1))
col = FIX(col / 5 - 1)
IF col < 0 THEN col = 0
POKE yp * 320 + xp, col
fastout:
NEXT
NEXT
sg = &HA000 + &H7D0
DEF SEG = sg
FOR yp = 1 TO 99
FOR xp = 0 TO 319
col = PEEK(yp * 320 + xp)
col = col + PEEK(yp * 320 + (xp - 1))
' ************** BLACK JUMP ROUTINE **************************
IF col = 0 THEN GOTO fastout1: ' BLACK JUMP
' ************************************************************
col = col + PEEK((yp - 1) * 320 + xp)
col = col + PEEK((yp + 1) * 320 + xp)
col = col + PEEK(yp * 320 + (xp + 1))
col = FIX(col / 5 - 1)
IF col < 0 THEN col = 0
POKE yp * 320 + xp, col
fastout1:
NEXT
NEXT
DEF SEG
END SUB

DEFSNG A-Z
SUB ReadRGB (red%, grn%, blu%, slot%)
  '
  OUT &H3C7, slot% ' Read RGB values from slot
  '
  red% = INP(&H3C9)
  grn% = INP(&H3C9)
  blu% = INP(&H3C9)
  '
END SUB

DEFINT A-Z
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

SUB SetPal (start.slot%, end.slot%)
  '
  num.slots% = end.slot% - start.slot%
  '
  CALL ReadRGB(sr%, sg%, sb%, start.slot%)
  CALL ReadRGB(er%, eg%, eb%, end.slot%)
  '
  rr% = ABS(er% - sr%): rg% = ABS(eg% - sg%): rb% = ABS(eb% - sb%)
  rs% = SGN(er% - sr%): gs% = SGN(eg% - sg%): bs% = SGN(eb% - sb%)
  '
  stepr = (rr% / num.slots%) * rs%
  stepg = (rg% / num.slots%) * gs%
  stepb = (rb% / num.slots%) * bs%
  '
  R = sr%: g = sg%: b = sb%
  wr% = R: wg% = g: wb% = b
  '
  FOR t% = start.slot% TO end.slot%
    '
    CALL WriteRGB(wr%, wg%, wb%, t%)
    '
    R = R + stepr: wr% = R
    g = g + stepg: wg% = g
    b = b + stepb: wb% = b
    '
  NEXT t%
  '
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

SUB WriteRGB (red%, grn%, blu%, slot%)
  '
  OUT &H3C8, slot% ' Write RGB values to slot
  '
  OUT &H3C9, red%
  OUT &H3C9, grn%
  OUT &H3C9, blu%
  '
END SUB