'===========================================================================
' Subject: ENHANCED FIRE EFFECT V3.2         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.2beta"
PRINT "--------------------------"
PRINT "Features:"
PRINT
PRINT "Four Pixel Interpolation (4+1 complete)           v2"
PRINT "Improved Black Jump                               v2"
PRINT "Improved White Jump with color prediction routine v3beta"
PRINT "Random Color Adjustment"
PRINT "--------------------------"
PRINT "SET VARIABLES:               (press enter for defaults) "
PRINT
PRINT
INPUT "X DIM (50,320)"; xdim
IF xdim > 320 THEN xdim = 320
IF xdim < 50 THEN xdim = 50
INPUT "Y DIM (50,200)"; ydim
IF ydim > 200 THEN ydim = 200
IF ydim < 50 THEN ydim = 50
INPUT "Color Fade Speed (0.1,3)"; b
IF b > 3 THEN b = 1
IF b < .1 THEN b = .1
INPUT "Random Color Value (-3,3)"; rd$
IF rd$ = "" THEN rd = 0: GOTO nocheck
rd = VAL(rd$)
IF rd > 3 THEN rd = 3
IF rd < -3 THEN rd = 3
nocheck:
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
pal 49, 63, 63, 0

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

DO

' DISPLAY ROUTINE

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

' UPDATE ROUTINE

FOR j = 1 TO vn
IF xvf1(j) = 0 THEN xvp1(j) = xvp1(j) - 1
IF xvf1(j) = 1 THEN xvp1(j) = xvp1(j) + 1
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) - 1
IF yvf1(j) = 1 THEN yvp1(j) = yvp1(j) + 1
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) - 1
IF xvf2(j) = 1 THEN xvp2(j) = xvp2(j) + 1
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) - 1
IF yvf2(j) = 1 THEN yvp2(j) = yvp2(j) + 1
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 !!!

FOR yp = 0 TO ydim
FOR xp = 0 TO xdim

col = POINT(xp, yp)
col = col + POINT(xp - 1, yp)

' ************** BLACK and WHITE JUMP ROUTINE ****************
IF col = 0 THEN GOTO fastout: ' BLACK JUMP
IF col >= 72 THEN col = (col - (col / 3)) / 2: GOTO fastout2: ' WHITE JUMP
' ************************************************************

col = col + POINT(xp, yp - 1)
col = col + POINT(xp, yp + 1)
col = col + POINT(xp + 1, yp)
col = INT(col / 5 - b)
'IF col < 0 THEN col = 0
'IF col > 48 THEN col = 48

fastout2:
PSET (xp, yp), col + (RND * rd)
fastout:

NEXT
NEXT
LOOP

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