'===========================================================================
' Subject: BURNING FIRE SIMULATOR            Date: 07-31-96 (01:12)       
' Author:  Tony Cave                         Code: QB, QBasic, PDS        
' Origin:  FidoNet QUIK_BAS Echo           Packet: GRAPHICS.ABC
'===========================================================================
'burning.bas is a fire simulator followed by a palette manipulator
'1 compile the program (Qbasic v1.1 users see REMarks in SUB getsizes)
'  (you need to save this in QB to generate the DECLARE statements)
'2 run the program specifying window size
'  EXAMPLE: burning 100 80
'  where 100 is the x value and 80 is the y value
'  executing burning with no parameters uses the default values.
'  (you might want to use the defaults first to get a feel for it)
'  for great palette manipulations try using:  burning 200 160
'3 when you want to freeze the screen and go into palette manipulations,
'  press a key
'4 in the palette manipulations:
'  press "P" for a different palette set
'        "-" to slow down palette rotation
'        "+" or "=" to speed up palette rotation
'        "Q" to quit
'Feedback would be appreciated (especially on speeding up the fire sub)
DIM ca(9, 256)
ID$ = "BURNING.BAS (c) 1996 by Tony Cave"
screenmode  ' setup the screen
getsizes    ' get the screen sizes
firepal     ' setup palette for fire
circleback  ' draw circular background (REM this out if you don't like it)
randback    ' draw random background to speed up fire simulation
fire        ' fire simulation
colors      ' palette manipulations
'NOTE: This program is not guaranteed to do anything.  The author
'of this program claims no responsibility for anything that happens.
'If any damage is done, it is the fault of the user of this program.
SUB circleback
FOR cir = 0 TO 255    'add this sub for a circle background
CIRCLE (160, 100), cir * 203 / 255, cir / 2
CIRCLE (160 + 1, 100), cir * 203 / 255, cir / 2
NEXT
END SUB
SUB colors
SHARED a$
DO
 DO
  cycle
  delay
  getkey
 LOOP UNTIL a$ <> ""
 keycheck
LOOP
END SUB
SUB cycle                    'cycle the palette
SHARED red%, green%, blue%
rgb 1
u1% = red%: u2% = green%: u3% = blue%
FOR t = 1 TO 254
 rgb t + 1
 OUT &H3C8, t: OUT &H3C9, red%: OUT &H3C9, green%: OUT &H3C9, blue%
NEXT
 OUT &H3C8, 255: OUT &H3C9, u1%: OUT &H3C9, u2%: OUT &H3C9, u3%
END SUB
SUB delay
SHARED m7
FOR asdf = 1 TO m7: NEXT
END SUB
SUB findrgb (x%, y%)          'finds the rgb of a particular pixel
SHARED red%, green%, blue%
c% = POINT(x%, y%)
OUT &H3C7, c%
red% = INP(&H3C9)
green% = INP(&H3C9)
blue% = INP(&H3C9)
END SUB
SUB fire
SHARED sizex, sizey, space, ca()
DIM x AS INTEGER, y AS INTEGER, avg AS INTEGER
DO
x = INT(RND * sizex) * space - INT(sizex / 2) * space + 160
y = INT(RND * sizey) * space - INT(sizey / 2) * space + 100
avg = POINT(x - space, y + space)
avg = (avg + POINT(x + space, y + space) + POINT(x, y + space)) \ 3
avg = avg * -(avg < 255)
PUT (x - 1, y - 1), ca(1, avg + 1), PSET
LOOP UNTIL INKEY$ <> ""
END SUB
SUB firepal               'the starting palette
FOR pu = 1 TO 255
 OUT &H3C8, pu
 OUT &H3C9, (126 - (ABS(pu - 128))) / 2
 OUT &H3C9, (126 - (ABS(pu - 128))) / 4
 OUT &H3C9, 0'((ABS(pu - 128))) / 4
'LINE (pu, 0)-(pu, 25), pu  'This is to check out the palette
NEXT pu
PALETTE 128, &H20303F
END SUB
SUB getkey
SHARED a$
a$ = INKEY$
END SUB
SUB getsizes                'get the screen size
SHARED sizex, sizey, hsizex, hsizey, space
space = 1  'distance apart for pixels or boxes or whatever
sizex = VAL(LEFT$(COMMAND$, 3))
sizey = VAL(RIGHT$(COMMAND$, 3))
'Qbasic users REM out the above 2 lines and unREM the below line
'sizex = 20: sizey = 20  'change these to what ever you want but
                         'larger numbers slow it down alot
                         'For good palette manipulations, change to
                         'sizex=316:sizey=196 and wait about 7 min
                         'before pressing a key
a = sizex: B = sizey: c = 318: d = 198
sizex = a * ABS((a <> 0) AND (a < c)) + 50 * ABS(a = 0) + c * ABS(a > c)
sizey = B * ABS((B <> 0) AND (B < d)) + 30 * ABS(B = 0) + d * ABS(B > d)
hsizex = INT(sizex / 2)
hsizey = INT(sizey / 2)
END SUB
SUB keycheck
SHARED a$, m7
 IF a$ = "=" OR a$ = "+" THEN
 m7 = m7 - 1000: m7 = m7 * -((m7 - 1000) > 999)
 END IF
 IF a$ = "-" THEN m7 = m7 + 1000
 IF UCASE$(a$) = "P" THEN nextpal
 IF UCASE$(a$) = "Q" THEN DEF SEG : SYSTEM
END SUB
SUB nextpal
SHARED palnum, red%, green%, blue%
nop = 5    'number of valid palette sets in case you want to add more
palnum = palnum + 1
IF palnum > nop THEN palnum = 1
SELECT CASE palnum
CASE 1
PALETTE
CASE 2
t = 0: m = 0
FOR pu = 1 TO 255
 IF t = 0 THEN count = count + 1: IF count > 31 THEN t = 1
 IF t = 1 THEN count = count - 1: IF count < 1 THEN t = 0: m = m + 1
 IF m > 3 THEN m = 0
 OUT &H3C8, pu
 OUT &H3C9, INT((32 - count) * 63 / 32) * ((m = 0) OR (m = 3))
 OUT &H3C9, INT((32 - count) * 63 / 32) * ((m = 1) OR (m = 3))
 OUT &H3C9, INT((32 - count) * 63 / 32) * ((m = 2) OR (m = 3))
NEXT pu
PALETTE 255, 0
CASE 3
se = INT(.03 * 127): th = INT(.08 * 127): fo = INT(.99 * 127)
FOR pu = 1 TO se
 OUT &H3C8, pu: OUT &H3C9, 0: OUT &H3C9, 0: OUT &H3C9, 32
NEXT pu
FOR pu = se TO th
 OUT &H3C8, pu: OUT &H3C9, 0: OUT &H3C9, 0
 OUT &H3C9, INT((pu - se) * (31 / (th - se))) + 32
NEXT pu
FOR pu = th TO fo
 OUT &H3C8, pu: OUT &H3C9, 0: OUT &H3C9, 0
 OUT &H3C9, 63 - (INT((pu - th) * (31 / (fo - th))) + 32)
NEXT pu
FOR pu = fo TO 127
 OUT &H3C8, pu
 OUT &H3C9, INT((pu - fo) * (63 / (127 - fo)))
 OUT &H3C9, INT((pu - fo) * (63 / (127 - fo)))
 OUT &H3C9, 63
NEXT pu
FOR pu = 128 TO 255
 rgb 255 - pu
 OUT &H3C8, pu: OUT &H3C9, red%: OUT &H3C9, green%: OUT &H3C9, blue%
NEXT pu
CASE 4
t = 0: m = 0
FOR pu = 1 TO 255
 IF t = 0 THEN count = count + 1: IF count > 6 THEN t = 1
 IF t = 1 THEN count = count - 1: IF count < 1 THEN t = 0: m = m + 1
 IF m > 3 THEN m = 0
 OUT &H3C8, pu
 OUT &H3C9, INT((7 - count) * 63 / 7) * ((m = 0))' OR (m = 3))
 OUT &H3C9, INT((7 - count) * 63 / 7) * ((m = 1))' OR (m = 3))
 OUT &H3C9, INT((7 - count) * 63 / 7) * ((m = 2))' OR (m = 3))
NEXT pu
PALETTE 255, 0
CASE 5
FOR pu = 1 TO 255
 OUT &H3C8, pu
 OUT &H3C9, (126 - (ABS(pu - 128))) / 2
 OUT &H3C9, (126 - (ABS(pu - 128))) / 4
 OUT &H3C9, 0'((ABS(pu - 128))) / 4
'LINE (pu, 0)-(pu, 25), pu
NEXT pu
PALETTE 128, &H20303F
END SELECT
END SUB
SUB randback
DIM c AS INTEGER
SHARED sizex, sizey
fy1 = ABS(sizey / 2 <> sizey \ 2): fy2 = NOT ABS(fy1)
fx1 = ABS(sizex / 2 <> sizex \ 2): fx2 = NOT ABS(fx1)
FOR y = 100 - sizey / 2 - 1 + fy1 TO 100 + sizey / 2 + 1 + fy2
FOR x = 160 - sizex / 2 - 1 + fx1 TO 160 + sizex / 2 + 1 + fy2
c = INT(RND * 50 + 206)
'use the following two lines for a special background
'c = (COS((y * .03515625# - 3.515625) ^ 2) * 63.75 + 63.75)
'c = c + (COS((x * .0265625 - 4.25) ^ 2) * 63.75 + 63.75)
POKE INT(y) * 320 + INT(x), c
NEXT
NEXT
END SUB
SUB rgb (gluupin%)           'finds the rgb of a color attribute
SHARED red%, green%, blue%
OUT &H3C7, gluupin%
red% = INP(&H3C9): green% = INP(&H3C9): blue% = INP(&H3C9)
END SUB
SUB screenmode
SHARED ca()
DEF SEG = &HA000
SCREEN 13
FOR x = 0 TO 765 STEP 3
x2 = x + 318 * (x > 315)
x3 = x2 + 318 * (x2 > 315)
y = (-(x > 315) - (x > 630)) * 3
LINE (x3, y)-(x3 + 2, y + 2), x / 3, BF
GET (x3, y)-(x3 + 2, y + 2), ca(1, x / 3) 'put colors into array to
NEXT                                      'speed up the fire sub
END sub