'===========================================================================
' Subject: ENHANCED FIRE EFFECT V3.0         Date: 01-15-97 (01:00)       
' Author:  Angelo Ken Pesce                  Code: QB, QBasic, PDS        
' Origin:  ken@uniserv.uniplan.it          Packet: GRAPHICS.ABC
'===========================================================================
' FOR BETTER RESULTS COMPILE IT WITH ALTERNATE MATH PDS' 7 OPTION

DECLARE SUB pal (c%, r%, g%, b%)
REM ******************************************************* CONFIG

DEFINT A-Z

'********************************************************** initialize vars

CLS
RANDOMIZE (TIMER)

PRINT "ANGELO KEN PESCE 1996 - PHOBIA 1996 (pallette routine)"
PRINT "QuickBasic Fire Demo             v3"
PRINT "--------------------------"
PRINT "Features:"
PRINT
PRINT "Three Pixel Interpolation (3+1)  v2"
PRINT "Improved Black Jump              v2"
PRINT "--------------------------"
PRINT "SET VARIABLES:               (press enter for defaults) "
PRINT
PRINT
INPUT "X DIM (100-320)"; xdim
IF xdim > 320 THEN xdim = 320
IF xdim < 100 THEN xdim = 100
INPUT "Y DIM (100-200)"; ydim
IF ydim > 200 THEN ydim = 200
IF ydim < 100 THEN ydim = 100
1 INPUT "X SPEED (0-3) (not working propely yet)"; xvel
IF xvel > 3 OR xvel < 0 THEN PRINT "MINIMUM VEL 0, MAXIMUM VEL 3": GOTO 1
2 INPUT "Y SPEED (0-3) (not working propely yet)"; yvel
IF yvel > 3 OR yvel < 0 THEN PRINT "MINIMUM VEL 0, MAXIMUM VEL 3": GOTO 2
INPUT "C Speed (0.1-1)"; b
IF b > 1 THEN b = 1
IF b < .1 THEN b = .1
INPUT "Lines (1-15)"; vn
IF vn > 15 THEN vn = 15
IF vn < 1 THEN vn = 1

SCREEN 13

'********************************************************** Init. Arrays

DIM xvp1(vn)
DIM xvp2(vn)
DIM yvp1(vn)
DIM yvp2(vn)
DIM xvf1(vn)
DIM xvf2(vn)
DIM yvf1(vn)
DIM yvf2(vn)

FOR j = 1 TO vn
xvp1(j) = INT((xdim + 1) * RND + 1)
xvp2(j) = INT((xdim + 1) * RND + 1)
yvp1(j) = INT((ydim + 1) * RND + 1)
yvp2(j) = INT((ydim + 1) * RND + 1)
NEXT

REM ******************************************************* PALETTE INIT
' THIS ROUTINE WAS MADE BY PHOBIA 1996!!!

FOR a% = 0 TO 63               ' Change the palette, colors 0-48
   pal a% / 4, a%, 0, 0
   pal a% / 4 + 16, 63, a%, 0
   pal a% / 4 + 32, 63, 63, a%
NEXT

REM *********************************************** LINE PLOTTING ROUTINE

DO

' DISPLAY ROUTINE

FOR j = 1 TO vn
LINE (xvp1(j), yvp1(j))-(xvp2(j), yvp2(j)), 48
NEXT

' UPDATE ROUTINE

FOR j = 1 TO vn

 IF xvf1(j) = 0 THEN xvp1(j) = xvp1(j) - 2
 IF xvf1(j) = 1 THEN xvp1(j) = xvp1(j) + 2
 IF xvp1(j) < 0 THEN xvp1(j) = 0: xvf1(j) = 1
 IF xvp1(j) > xdim THEN xvp1(j) = xdim: xvf1(j) = 0
 IF yvf1(j) = 0 THEN yvp1(j) = yvp1(j) - 2
 IF yvf1(j) = 1 THEN yvp1(j) = yvp1(j) + 2
 IF yvp1(j) < 0 THEN yvp1(j) = 0: yvf1(j) = 1
 IF yvp1(j) > ydim THEN yvp1(j) = ydim: yvf1(j) = 0
 IF xvf2(j) = 0 THEN xvp2(j) = xvp2(j) - 2
 IF xvf2(j) = 1 THEN xvp2(j) = xvp2(j) + 2
 IF xvp2(j) < 0 THEN xvp2(j) = 0: xvf2(j) = 1
 IF xvp2(j) > xdim THEN xvp2(j) = xdim: xvf2(j) = 0
 IF yvf2(j) = 0 THEN yvp2(j) = yvp2(j) - 2
 IF yvf2(j) = 1 THEN yvp2(j) = yvp2(j) + 2
 IF yvp2(j) < 0 THEN yvp2(j) = 0: yvf2(j) = 1
 IF yvp2(j) > ydim THEN yvp2(j) = ydim: yvf2(j) = 0

NEXT

REM ************************************************************** FIRE !!!

CONST xstart = 0, ystart = 0
xend = xdim
yend = ydim
CONST cmax = 48
FOR yp = ystart TO yend
FOR xp = xstart TO xend

col = POINT(xp + 1, yp)
col = col + POINT(xp - 1, yp)
' ************** BLACK and WHITE JUMP ROUTINE ****************
IF col = 0 THEN GOTO fastout
'IF col >= 72 THEN col = (col + 72) / 4: GOTO fastout2
' ************************************************************

col = col + POINT(xp, yp + 1)
col = col + POINT(xp, yp - 1)
col = INT(col / 4 - b)
IF col < 0 THEN col = 0
IF col > cmax THEN col = cmax
fastout2:
PSET (xp - xvel, yp - yvel), col
fastout:
NEXT
NEXT
LOOP

SUB pal (c%, r%, g%, b%)
OUT &H3C7, c%
OUT &H3C9, r%
OUT &H3C9, g%
OUT &H3C9, b%
END SUB