DECLARE SUB MakeBmp (f$, x!, y!, c!)
DECLARE FUNCTION Max! (num!, mx!)
DECLARE FUNCTION Rever$ (num!)
DECLARE SUB PaletteBar ()
DECLARE SUB MakeGrid (Acuracy!)
DECLARE SUB Solarize (r!, g!, B!)
DECLARE SUB Negative ()
DECLARE SUB Mosaic (sz!)
DECLARE SUB ChangePal (Red%, Green%, Blue%, syscolor%)
DECLARE SUB ShowBitmap (f$, mde!)
DECLARE FUNCTION FillIn$ (t$, num!)
DECLARE SUB ReadPal (Red%, Green%, Blue%)
DECLARE FUNCTION Exist! (fle$)
CLS
PALETTE 0, 23
COLOR 1, 0
PRINT "Press any key to begin the sequence"
DO WHILE INKEY$ = ""
FOR q = 0 TO 4
PALETTE 0, 63
NEXT q
FOR q = 0 TO 3
PALETTE 0, 0
NEXT q
LOOP
CLEAR , , 15000
'==== All variables set above this line are ignored ====
CONST mx = 20
CONST Bmp$ = "Q:\LOGO.SYS"
ShowBitmap Bmp$, 2
FOR q = 1 TO mx + 1
d$ = "TEMP" + LTRIM$(RTRIM$(STR$(q - 1))) + ".BSV"
IF Exist(d$) THEN xx = 1
IF Lstxx = 0 THEN ShowBitmap Bmp$, 3
IF xx = 0 THEN Mosaic q
DEF SEG = &HA000
IF xx = 0 THEN BSAVE d$, 0, 64000
Lstxx = xx
NEXT q

CLEAR , , 1000
Negative
DO WHILE INKEY$ = ""
DEF SEG = &HA000
d = TIMER
FOR a = mx TO 0 STEP -1
d$ = "TEMP" + LTRIM$(RTRIM$(STR$(a))) + ".BSV"
BLOAD d$, 0
NEXT a
s = TIMER
'PaletteBar
'LOCATE 1, 1: PRINT CINT(mx / (s - d)); " frames per second": SLEEP 1
Negative
SLEEP 1
FOR a = 0 TO mx STEP 1
d$ = "TEMP" + LTRIM$(RTRIM$(STR$(a))) + ".BSV"
BLOAD d$, 0
NEXT a
SLEEP 1
Negative
LOOP
Negative
KILL "TEMP?.BSV"
KILL "TEMP??.BSV"
KILL "TEMP???.BSV"
CLEAR , , 15000

SUB ChangePal (Red%, Green%, Blue%, syscolor%)
palmask = &H3C6
palregrd = &H3CF
palregwr = &H3C8
paldata = &H3C9
OUT palmask, &HFF
OUT palregwr, syscolor%
OUT paldata, Red%
OUT paldata, Green%
OUT paldata, Blue%
END SUB

FUNCTION Exist (fle$)
OPEN fle$ FOR BINARY AS #4
IF LOF(4) = 0 THEN Exist = 0 ELSE Exist = 1
CLOSE 4
END FUNCTION

FUNCTION FillIn$ (t$, num)
FillIn$ = STRING$(num - LEN(t$), ASC("0")) + t$
END FUNCTION

SUB MakeBmp (f$, x, y, c)
DIM Red AS STRING * 1
DIM Green AS STRING * 1
DIM Blue AS STRING * 1
OPEN f$ FOR BINARY AS #1
IF LOF(1) <> 0 THEN CLOSE 1: KILL f$ ELSE CLOSE 1
Header$ = "BM6" + CHR$(254) + CHR$(0) + CHR$(0) + CHR$(0) + CHR$(0) + CHR$(0) + CHR$(0) + CHR$(54)
Header$ = Header$ + CHR$(4) + CHR$(0) + CHR$(0) + CHR$(40) + CHR$(0) + CHR$(0) + CHR$(0) + Rever$(x)
Header$ = Header$ + CHR$(0) + CHR$(0) + Rever$(y) + CHR$(0) + CHR$(0) + Rever$(c) + CHR$(8) + CHR$(0)
Header$ = Header$ + CHR$(0) + CHR$(0) + CHR$(0) + CHR$(0) + CHR$(0) + CHR$(250) + CHR$(0) + CHR$(0)
Header$ = Header$ + CHR$(0) + CHR$(0) + CHR$(0) + CHR$(0) + CHR$(0) + CHR$(0) + CHR$(0) + CHR$(0) + CHR$(0)
Header$ = Header$ + CHR$(1) + CHR$(0) + CHR$(0) + CHR$(0) + CHR$(1) + CHR$(0) + CHR$(0)
OPEN f$ FOR BINARY AS #1
PUT #1, 1, Header$
FOR i% = 0 TO c - 1
        ReadPal CCHex3%, CCHex2%, CCHex1%
        Red = CHR$(Max((CCHex3%) * 8, 255))
        Green = CHR$(Max((CCHex2%) * 8, 255))
        Blue = CHR$(Max((CCHex1%) * 8, 255))
        PUT #1, 55 + (i% * 4), Red
        PUT #1, 55 + (i% * 4) + 1, Green
        PUT #1, 55 + (i% * 4) + 2, Blue
NEXT i%




DEF SEG = &HA000
DIM v AS STRING * 10000
DIM seven AS STRING * 7
Inc = 10000
IF c = 16 THEN n = 2 ELSE n = 1
FOR q = 55 + (i% * 4) TO INT((x * y) / n) STEP Inc
BSAVE "1.Tmp", x1, Inc
OPEN "1.TMP" FOR BINARY AS #3
GET #3, 1, seven
GET #3, , v
CLOSE #3
KILL "1.Tmp"
PUT #1, q, v
x1 = x1 + Inc
NEXT q
CLOSE 1, 3
END SUB

SUB MakeGrid (Acuracy)
sz = Acuracy
FOR x = 0 TO 320 STEP sz
FOR y = 0 TO 200 STEP sz
c = POINT(x + sz, y)
LINE (x, y)-(x + sz - 1, y + sz - 1), c, B
NEXT y
NEXT x
END SUB

FUNCTION Max (num, mx)
IF num > mx THEN Max = mx ELSE Max = num
END FUNCTION

SUB Mosaic (sz)
IF sz <= 1 THEN EXIT SUB
FOR x = 0 TO 320 STEP sz
FOR y = 0 TO 200 STEP sz
c = POINT(x, y)
LINE (x, y)-(x + sz - 1, y + sz - 1), c, BF
NEXT y
NEXT x
END SUB

SUB Negative
Solarize 255, 255, 255
END SUB

SUB PaletteBar
FOR q = 0 TO 255
LINE (q, 0)-(q, 8), q
NEXT q
END SUB

SUB ReadPal (Red%, Green%, Blue%)
palmask = &H3C6
paldata = &H3C9
IF INT(Colr% / 2) = Colr% / 2 THEN Red% = INP(paldata): Green% = INP(paldata): Blue% = INP(paldata)
Red% = INP(paldata)
Green% = INP(paldata)
Blue% = INP(paldata)
END SUB

FUNCTION Rever$ (num)
f$ = HEX$(num)
f$ = STRING$(4 - LEN(f$), ASC("0")) + f$
Rever$ = CHR$(VAL("&H" + MID$(f$, 3, 2))) + CHR$(VAL("&H" + MID$(f$, 1, 2)))
END FUNCTION

SUB ShowBitmap (f$, mde)
DIM Red AS STRING * 1
DIM Green AS STRING * 1
DIM Blue AS STRING * 1
DIM PicType AS STRING * 1
OPEN f$ FOR BINARY AS #1
  GET #1, 29, PicType
mxcol = ASC(PicType)
SCREEN 13
IF mde = 2 THEN
        FOR i% = 0 TO 255
        GET #1, 55 + (i% * 4), Red
        GET #1, 55 + (i% * 4) + 1, Green
        GET #1, 55 + (i% * 4) + 2, Blue
        CCHex1% = INT(ASC(Red)) / 8
        CCHex2% = INT(ASC(Green)) / 8
        CCHex3% = INT(ASC(Blue)) / 8
        ChangePal CCHex3%, CCHex2%, CCHex1%, i%
        NEXT i%
END IF
DEF SEG = &HA000
DIM v AS STRING * 10000
Inc = 10000
pt1$ = CHR$(253) + CHR$(0) + CHR$(160)
pt2$ = CHR$(VAL("&H" + MID$(FillIn$(HEX$(Inc), 4), 3, 2))) + CHR$(VAL("&H" + MID$(FillIn$(HEX$(Inc), 4), 1, 2)))
FOR q = 1079 TO 64000 STEP Inc
GET #1, q, v
OPEN "1.TMP" FOR BINARY AS #3
pt3$ = CHR$(VAL("&H" + MID$(FillIn$(HEX$(x1), 4), 3, 2))) + CHR$(VAL("&H" + MID$(FillIn$(HEX$(x1), 4), 1, 2)))
PUT #3, , pt1$
PUT #3, , pt3$
PUT #3, , pt2$
PUT #3, , v
CLOSE 3
BLOAD "1.TMP", x1
KILL "1.TMP"
x1 = x1 + Inc
NEXT q
IF mde = 1 THEN
        FOR i% = 0 TO 255
        GET #1, 55 + (i% * 4), Red
        GET #1, 55 + (i% * 4) + 1, Green
        GET #1, 55 + (i% * 4) + 2, Blue
        CCHex1% = INT(ASC(Red)) / 8
        CCHex2% = INT(ASC(Green)) / 8
        CCHex3% = INT(ASC(Blue)) / 8
        ChangePal CCHex3%, CCHex2%, CCHex1%, i%
        NEXT i%
END IF
CLOSE 1, 2, 3
END SUB

SUB Solarize (r, g, B)
        FOR i% = 0 TO 255
        ReadPal CCHex3%, CCHex2%, CCHex1%
        ChangePal ABS(CCHex3% - r), ABS(CCHex2% - g), ABS(CCHex1% - B), i%
        NEXT i%
END SUB