'===========================================================================
' Subject: FULL SCREEN FLAMES                Date: 08-08-98 (05:29)       
' Author:  Andre Victor                      Code: QB, QBasic, PDS        
' Origin:  anvictor@ruralsp.com.br         Packet: GRAPHICS.ABC
'===========================================================================
' FLAMES by M.D.Mackey (C) 1993 E-mail:mackey@aqueous.ml.csiro.au
' QBasic version 1998 by Andre V1ctor / BRAZIL

' Load QB.QLB... qb /l

DEFINT A-Z
'$DYNAMIC

DECLARE SUB Flames ()
DECLARE SUB Pal (c AS INTEGER, r AS INTEGER, g AS INTEGER, b AS INTEGER)
DECLARE SUB SetupPal ()

     DIM SHARED flm(0 TO 159, 0 TO 101) AS INTEGER

     DIM FlamesCd(0 TO 48) AS STRING * 1
     DIM CopyCd(0 TO 77) AS STRING * 1

     RESTORE Copy                              ' Read machine-language procs
    FOR i = 0 TO 77
     READ cd
     CopyCd(i) = CHR$(cd)
    NEXT i
   
     RESTORE Flames
    FOR i = 0 TO 48
     READ cd
     FlamesCd(i) = CHR$(cd)
    NEXT i
    
     SCREEN 13

     SetupPal

   FOR y = 0 TO 101
    FOR x = 0 TO 159
     flm(x, y) = 0                 ' initialise array
    NEXT x
   NEXT y

     Flames                        ' do it

         
FlamesPalette:
DATA 00,00,00,00,00,06,00,00,06,00,00,07,00,00,08,00
DATA 00,08,00,00,09,00,00,0A,02,00,0A,04,00,09,06,00
DATA 09,08,00,08,0A,00,07,0C,00,07,0E,00,06,10,00,05
DATA 12,00,05,14,00,04,16,00,04,18,00,03,1A,00,02,1C
DATA 00,02,1E,00,01,20,00,00,20,00,00,21,00,00,22,00
DATA 00,23,00,00,24,00,00,24,00,00,25,00,00,26,00,00
DATA 27,00,00,28,00,00,28,00,00,29,00,00,2A,00,00,2B
DATA 00,00,2C,00,00,2D,00,00,2E,01,00,2F,01,00,30,02
DATA 00,31,02,00,32,03,00,33,03,00,34,04,00,35,04,00
DATA 36,05,00,37,05,00,38,06,00,39,06,00,3A,07,00,3B
DATA 07,00,3C,08,00,3D,08,00,3F,09,00,3F,09,00,3F,0A
DATA 00,3F,0A,00,3F,0B,00,3F,0B,00,3F,0C,00,3F,0C,00
DATA 3F,0D,00,3F,0D,00,3F,0E,00,3F,0E,00,3F,0F,00,3F
DATA 0F,00,3F,10,00,3F,10,00,3F,11,00,3F,11,00,3F,12
DATA 00,3F,12,00,3F,13,00,3F,13,00,3F,14,00,3F,14,00
DATA 3F,15,00,3F,15,00,3F,16,00,3F,16,00,3F,17,00,3F
DATA 18,00,3F,18,00,3F,19,00,3F,19,00,3F,1A,00,3F,1A
DATA 00,3F,1B,00,3F,1B,00,3F,1C,00,3F,1C,00,3F,1D,00
DATA 3F,1D,00,3F,1E,00,3F,1E,00,3F,1F,00,3F,1F,00,3F
DATA 20,00,3F,20,00,3F,21,00,3F,21,00,3F,22,00,3F,22
DATA 00,3F,23,00,3F,23,00,3F,24,00,3F,24,00,3F,25,00
DATA 3F,26,00,3F,26,00,3F,27,00,3F,27,00,3F,28,00,3F
DATA 28,00,3F,29,00,3F,29,00,3F,2A,00,3F,2A,00,3F,2B
DATA 00,3F,2B,00,3F,2C,00,3F,2C,00,3F,2D,00,3F,2D,00
DATA 3F,2E,00,3F,2E,00,3F,2F,00,3F,2F,00,3F,30,00,3F
DATA 30,00,3F,31,00,3F,31,00,3F,32,00,3F,32,00,3F,33
DATA 00,3F,34,00,3F,34,00,3F,34,00,3F,34,00,3F,34,00
DATA 3F,35,00,3F,35,00,3F,35,00,3F,35,00,3F,36,00,3F
DATA 36,00,3F,36,00,3F,36,00,3F,36,00,3F,37,00,3F,37
DATA 00,3F,37,00,3F,37,00,3F,38,00,3F,38,00,3F,38,00
DATA 3F,38,00,3F,39,00,3F,39,00,3F,39,00,3F,39,00,3F
DATA 39,00,3F,3A,00,3F,3A,00,3F,3A,00,3F,3A,00,3F,3B
DATA 00,3F,3B,00,3F,3B,00,3F,3B,00,3F,3C,00,3F,3C,00
DATA 3F,3C,00,3F,3C,00,3F,3C,00,3F,3D,00,3F,3D,00,3F
DATA 3D,00,3F,3D,00,3F,3E,00,3F,3E,00,3F,3E,00,3F,3E
DATA 00,3F,3F,00,3F,3F,01,3F,3F,02,3F,3F,03,3F,3F,04
DATA 3F,3F,05,3F,3F,06,3F,3F,07,3F,3F,08,3F,3F,09,3F
DATA 3F,0A,3F,3F,0A,3F,3F,0B,3F,3F,0C,3F,3F,0D,3F,3F
DATA 0E,3F,3F,0F,3F,3F,10,3F,3F,11,3F,3F,12,3F,3F,13
DATA 3F,3F,14,3F,3F,15,3F,3F,15,3F,3F,16,3F,3F,17,3F
DATA 3F,18,3F,3F,19,3F,3F,1A,3F,3F,1B,3F,3F,1C,3F,3F
DATA 1D,3F,3F,1E,3F,3F,1F,3F,3F,1F,3F,3F,20,3F,3F,21
DATA 3F,3F,22,3F,3F,23,3F,3F,24,3F,3F,25,3F,3F,26,3F
DATA 3F,27,3F,3F,28,3F,3F,29,3F,3F,2A,3F,3F,2A,3F,3F
DATA 2B,3F,3F,2C,3F,3F,2D,3F,3F,2E,3F,3F,2F,3F,3F,30
DATA 3F,3F,31,3F,3F,32,3F,3F,33,3F,3F,34,3F,3F,34,3F
DATA 3F,35,3F,3F,36,3F,3F,37,3F,3F,38,3F,3F,39,3F,3F
DATA 3A,3F,3F,3B,3F,3F,3C,3F,3F,3D,3F,3F,3E,3F,3F,3F

':::::::::::::::::::::::::::::::::::::::::::::::::
Copy:
DATA &H55:                     ' push           bp
DATA &H89, &He5:               ' mov            bp, sp
DATA &H57:                     ' push           di
DATA &H56:                     ' push           si
DATA &H06:                     ' push           es
DATA &H1e:                     ' push           ds
DATA &H8b, &H46, &H06:         ' mov            ax, ss;[bp + 06]
DATA &H8e, &Hd8:               ' mov            ds, ax
DATA &H33, &Hf6:               ' xor            si, si
DATA &Hb8, &H00, &Ha0:         ' mov            ax, 0A000h
DATA &H8e, &Hc0:               ' mov            es, ax
DATA &H33, &Hff:               ' xor            di, di
DATA &Hbd, &H04, &H00:         ' mov            bp, 4
DATA &Hba, &H32, &H00:         ' mov            dx, 50
DATA &Hbb, &H04, &H00:         ' L0:  mov       bx, 4
DATA &Hb9, &H50, &H00:         ' L1:  mov       cx, 320 / 4
DATA &H8a, &H04:               ' L2:  mov       al, ds;[si]
DATA &H88, &Hc4:               ' mov            ah, al
DATA &H26, &H89, &H05:         ' mov            es;[di], ax
DATA &H8a, &H44, &H02:         ' mov            al, ds;[si + 2]
DATA &H88, &Hc4:               ' mov            ah, al
DATA &H26, &H89, &H45, &H02:   ' mov            es;[di + 2], ax
DATA &H01, &Hef:               ' add            di, bp
DATA &H01, &Hee:               ' add            si, bp
DATA &H49:                     ' dec            cx
DATA &H75, &He9:               ' jnz            L2
DATA &H81, &Hee, &H40, &H01:   ' sub            si, 320
DATA &H4b:                     ' dec            bx
DATA &H75, &Hdf:               ' jnz            L1
DATA &H81, &Hc6, &H40, &H01:   ' add            si, 320
DATA &H4a:                     ' dec            dx
DATA &H75, &Hd5:               ' jnz            L0
DATA &H1f:                     ' pop            ds
DATA &H07:                     ' pop            es
DATA &H5e:                     ' pop            si
DATA &H5f:                     ' pop            di
DATA &H5d:                     ' pop            bp
DATA &Hca, &H02, &H00:         ' retf           (2)

':::::::::::::::::::::::::::::::::::::::::::::::::
Flames:
DATA &H8b, &Hdc:               ' mov            bx, sp
DATA &H56:                     ' push           si
DATA &H1e:                     ' push           ds
DATA &H36, &H8b, &H47, &H04:   ' mov            ax, ss;[bx + 4]
DATA &H8e, &Hd8:               ' mov            ds, ax
DATA &Hbe, &H40, &H01:         ' mov            si, 320  ; si ptr to 1st element of flm in upper row
DATA &Hb9, &H7f, &H3e:         ' mov            cx, (102 * 160) - 321  ; elements to change
DATA &H8b, &H04:               ' L0:  mov       ax, ds;[si]
DATA &H03, &H44, &Hfe:         ' add            ax, ds;[si - 2]
DATA &H03, &H44, &H02:         ' add            ax, ds;[si + 2]
DATA &H03, &H84, &H40, &H01:   ' add            ax, ds;[si + 320]
DATA &Hc1, &He8, &H02:         ' shr            ax, 2  ; divide by 4; average 4 elements of flm
DATA &H74, &H01:               ' jz             >L1
DATA &H48:                     ' dec            ax
DATA &H89, &H84, &Hc0, &Hfe:   ' L1:  mov       ds;[si - 320], ax
DATA &H83, &Hc6, &H02:         ' add            si, 2
DATA &H49:                     ' dec            cx
DATA &H75, &He4:               ' jnz            L0
DATA &H1f:                     ' pop            ds
DATA &H5e:                     ' pop            si
DATA &Hca, &H02, &H00:         ' retf           (2)

REM $STATIC
':::::::::::::::::::::::::::::::::::::::::::::::::
SUB Flames

     SHARED FlamesCd() AS STRING * 1
     SHARED CopyCd() AS STRING * 1
     DIM x AS INTEGER
     DIM delta AS INTEGER

   DO

     DEF SEG = VARSEG(FlamesCd(0)) ' move lines up, averaging
     CALL absolute(BYVAL VARSEG(flm(0, 0)), VARPTR(FlamesCd(0)))

    FOR x = 0 TO 159               ' set new bottom line
     delta = CINT(RND * 1) * 255
     flm(x, 100) = delta
     flm(x, 101) = delta
    NEXT x

     DEF SEG = VARSEG(CopyCd(0))   ' output to screen
     CALL absolute(BYVAL VARSEG(flm(0, 0)), VARPTR(CopyCd(0)))
      
   LOOP UNTIL INKEY$ > ""

END SUB

':::::::::::::::::::::::::::::::::::::::::::::::::
SUB Pal (c AS INTEGER, r AS INTEGER, g AS INTEGER, b AS INTEGER)
' This sets the Red, Green and Blue values of a certain color
    
     OUT &H3C8, c
     OUT &H3C9, r
     OUT &H3C9, g
     OUT &H3C9, b
END SUB

':::::::::::::::::::::::::::::::::::::::::::::::::
SUB SetupPal
     DIM i AS INTEGER
     DIM r AS STRING * 2, g AS STRING * 2, b AS STRING * 2
      
     RESTORE FlamesPalette
    FOR i = 0 TO 255
     READ r, g, b
     Pal i, VAL("&H" + r), VAL("&H" + g), VAL("&H" + b)
    NEXT i
   
END SUB