'===========================================================================
' Subject: FLAMES EFFECT                     Date: 05-31-98 (19:52)       
' Author:  Anders Olofsson                   Code: QB, QBasic, PDS        
' Origin:  anders.olofsson@mail.bip.net    Packet: GRAPHICS.ABC
'===========================================================================
' Flames.bas, by Anders Olofsson.
'
'             E-mail: anders.olofsson@mail.bip.net
'                     anders.olofsson@zonline.ostersund.se
'
' Compile for maximum speed!
' Included with small linebit font-routine.

DEFINT A-Z
DECLARE SUB Palet (Attr%, Red%, Green%, Blue%)
DECLARE SUB fPRINT (sx%, y%, Text$, C%)

SCREEN 13
RANDOMIZE TIMER

' Set palette
FOR A = 1 TO 63
 Palet A, A, 0, 0
 Palet A + 63, 63, A, 0
 Palet A + 126, 63, 63, A
NEXT A

DEF SEG = &HA000
LINE (55, 100)-(275, 100), 145
FOR y = 99 TO 50 STEP -1
 LINE (55, y)-(275, y), PEEK(320& * (y + 1) + 175) - 1
NEXT

fPRINT 114, 60, "Flame effect", 0
fPRINT 115, 60, "Flame effect", 70
fPRINT 69, 80, "By Anders Olofsson, 1998", 0
fPRINT 70, 80, "By Anders Olofsson, 1998", 70
fPRINT 50, 120, "Press any key to burn this!", 140

WHILE LEN(INKEY$): WEND
DO: LOOP UNTIL LEN(INKEY$)

CurrentColor = 20
DEF SEG = &HA000

DO
 IF CurrentColor < 140 THEN CurrentColor = CurrentColor + 15
 IF LEN(INKEY$) THEN CountDown = -1
 IF CountDown THEN
  CurrentColor = CurrentColor - 25
  IF CurrentColor < 0 THEN CurrentColor = 0
 END IF

 FOR x = 0 TO 323 STEP 3
  POKE 320& * 199 + x, CurrentColor
 NEXT
  FOR y = 199 TO 0 STEP -3
   FOR x = 0 TO 319 STEP 3
    C = PEEK(320& * y + x) - CINT(12 * RND)
     C = C + PEEK(320& * y - 1 + x + 1)
     C = C + PEEK(320& * y - 2 + x + 2)
     C = C + PEEK(320& * y - 3 + x + 3)
     C = C + PEEK(320& * y + x + 4)
     C = C \ 5
    IF C > 0 THEN LINE (x, y - 1)-(x + 3, y - 3), C, BF
   NEXT
  NEXT
LOOP UNTIL CurrentColor < 5
DEF SEG
SCREEN 0
WIDTH 80, 25
COLOR 14, 4
LOCATE 1, 2: PRINT " Flame effect "
COLOR 7, 0
PRINT "By Anders Olofsson, May 1998."
END

DEFSNG A-Z
SUB fPRINT (sx%, y%, Text$, C%)
x% = sx%
DEF SEG = &HF000
FOR T% = 1 TO LEN(Text$)
FOR ty% = y% TO y% + 7
 mask% = PEEK(&HFA63 + (ASC(MID$(Text$, T%, 1)) * 8) + 11 + ty% - y%) * 128
 LINE (x%, ty%)-STEP(7, 0), C%, , mask%
NEXT
 x% = x% + 8
NEXT
DEF SEG

END SUB

DEFINT A-Z
SUB Palet (Attr%, Red%, Green%, Blue%)
OUT &H3C8, Attr%
OUT &H3C9, Red%
OUT &H3C9, Green%
OUT &H3C9, Blue%
END SUB