1: DECLARE SUB MakeBmp (f$, x!, y!, c!) 2: DECLARE FUNCTION Max! (num!, mx!) 3: DECLARE FUNCTION Rever$ (num!) 4: DECLARE SUB PaletteBar () 5: DECLARE SUB MakeGrid (Acuracy!) 6: DECLARE SUB Solarize (r!, g!, B!) 7: DECLARE SUB Negative () 8: DECLARE SUB Mosaic (sz!) 9: DECLARE SUB ChangePal (Red%, Green%, Blue%, syscolor%) 10: DECLARE SUB ShowBitmap (f$, mde!) 11: DECLARE FUNCTION FillIn$ (t$, num!) 12: DECLARE SUB ReadPal (Red%, Green%, Blue%) 13: DECLARE FUNCTION Exist! (fle$) 14: CLS 15: PALETTE 0, 23 16: COLOR 1, 0 17: PRINT "Press any key to begin the sequence" 18: DO WHILE INKEY$ = "" 19: FOR q = 0 TO 4 20: PALETTE 0, 63 21: NEXT q 22: FOR q = 0 TO 3 23: PALETTE 0, 0 24: NEXT q 25: LOOP 26: CLEAR , , 15000 27: '==== All code above the line above this one is ignored ==== 28: CONST mx = 20 29: CONST Bmp$ = "C:\PSP\DEATH1.BMP" 30: ShowBitmap Bmp$, 2 31: FOR q = 1 TO mx + 1 32: d$ = "TEMP" + LTRIM$(RTRIM$(STR$(q - 1))) + ".BSV" 33: IF Exist(d$) THEN xx = 1 34: IF Lstxx = 0 THEN ShowBitmap Bmp$, 3 35: IF xx = 0 THEN Mosaic q 36: DEF SEG = &HA000 37: IF xx = 0 THEN BSAVE d$, 0, 64000 38: Lstxx = xx 39: NEXT q 40: 41: CLEAR , , 1000 42: Negative 43: DO WHILE INKEY$ = "" 44: DEF SEG = &HA000 45: d = TIMER 46: FOR a = mx TO 0 STEP -1 47: d$ = "TEMP" + LTRIM$(RTRIM$(STR$(a))) + ".BSV" 48: BLOAD d$, 0 49: NEXT a 50: s = TIMER 51: 'PaletteBar 52: 'LOCATE 1, 1: PRINT CINT(mx / (s - d)); " frames per second": SLEEP 1 53: Negative 54: SLEEP 1 55: FOR a = 0 TO mx STEP 1 56: d$ = "TEMP" + LTRIM$(RTRIM$(STR$(a))) + ".BSV" 57: BLOAD d$, 0 58: NEXT a 59: SLEEP 1 60: Negative 61: LOOP 62: Negative 63: CLEAR , , 15000 64: MakeBmp "ROY.BMP", 320, 200, 256 65: 66: SUB ChangePal (Red%, Green%, Blue%, syscolor%) 67: palmask = &H3C6 68: palregrd = &H3CF 69: palregwr = &H3C8 70: paldata = &H3C9 71: OUT palmask, &HFF 72: OUT palregwr, syscolor% 73: OUT paldata, Red% 74: OUT paldata, Green% 75: OUT paldata, Blue% 76: END SUB 77: 78: FUNCTION Exist (fle$) 79: OPEN fle$ FOR BINARY AS #4 80: IF LOF(4) = 0 THEN Exist = 0 ELSE Exist = 1 81: CLOSE 4 82: END FUNCTION 83: 84: FUNCTION FillIn$ (t$, num) 85: FillIn$ = STRING$(num - LEN(t$), ASC("0")) + t$ 86: END FUNCTION 87: 88: SUB MakeBmp (f$, x, y, c) 89: DIM Red AS STRING * 1 90: DIM Green AS STRING * 1 91: DIM Blue AS STRING * 1 92: OPEN f$ FOR BINARY AS #1 93: IF LOF(1) <> 0 THEN CLOSE 1: KILL f$ ELSE CLOSE 1 94: Header$ = "BM6" + CHR$(254) + CHR$(0) + CHR$(0) + CHR$(0) + CHR$(0) + CHR$(0) + CHR$(0) + CHR$(54) 95: Header$ = Header$ + CHR$(4) + CHR$(0) + CHR$(0) + CHR$(40) + CHR$(0) + CHR$(0) + CHR$(0) + Rever$(x) 96: Header$ = Header$ + CHR$(0) + CHR$(0) + Rever$(y) + CHR$(0) + CHR$(0) + Rever$(c) + CHR$(8) + CHR$(0) 97: Header$ = Header$ + CHR$(0) + CHR$(0) + CHR$(0) + CHR$(0) + CHR$(0) + CHR$(250) + CHR$(0) + CHR$(0) 98: Header$ = Header$ + CHR$(0) + CHR$(0) + CHR$(0) + CHR$(0) + CHR$(0) + CHR$(0) + CHR$(0) + CHR$(0) + CHR$(0) 99: Header$ = Header$ + CHR$(1) + CHR$(0) + CHR$(0) + CHR$(0) + CHR$(1) + CHR$(0) + CHR$(0) 100: OPEN f$ FOR BINARY AS #1 101: PUT #1, 1, Header$ 102: FOR i% = 0 TO c - 1 103: ReadPal CCHex3%, CCHex2%, CCHex1% 104: Red = CHR$(Max((CCHex3%) * 8, 255)) 105: Green = CHR$(Max((CCHex2%) * 8, 255)) 106: Blue = CHR$(Max((CCHex1%) * 8, 255)) 107: PUT #1, 55 + (i% * 4), Red 108: PUT #1, 55 + (i% * 4) + 1, Green 109: PUT #1, 55 + (i% * 4) + 2, Blue 110: NEXT i% 111: 112: 113: 114: 115: DEF SEG = &HA000 116: DIM v AS STRING * 10000 117: DIM seven AS STRING * 7 118: Inc = 10000 119: IF c = 16 THEN n = 2 ELSE n = 1 120: FOR q = 55 + (i% * 4) TO INT((x * y) / n) STEP Inc 121: BSAVE "1.Tmp", x1, Inc 122: OPEN "1.TMP" FOR BINARY AS #3 123: GET #3, 1, seven 124: GET #3, , v 125: CLOSE #3 126: KILL "1.Tmp" 127: PUT #1, q, v 128: x1 = x1 + Inc 129: NEXT q 130: CLOSE 1, 3 131: END SUB 132: 133: SUB MakeGrid (Acuracy) 134: sz = Acuracy 135: FOR x = 0 TO 320 STEP sz 136: FOR y = 0 TO 200 STEP sz 137: c = POINT(x + sz, y) 138: LINE (x, y)-(x + sz - 1, y + sz - 1), c, B 139: NEXT y 140: NEXT x 141: END SUB 142: 143: FUNCTION Max (num, mx) 144: IF num > mx THEN Max = mx ELSE Max = num 145: END FUNCTION 146: 147: SUB Mosaic (sz) 148: IF sz <= 1 THEN EXIT SUB 149: FOR x = 0 TO 320 STEP sz 150: FOR y = 0 TO 200 STEP sz 151: c = POINT(x, y) 152: LINE (x, y)-(x + sz - 1, y + sz - 1), c, BF 153: NEXT y 154: NEXT x 155: END SUB 156: 157: SUB Negative 158: Solarize 255, 255, 255 159: END SUB 160: 161: SUB PaletteBar 162: FOR q = 0 TO 255 163: LINE (q, 0)-(q, 8), q 164: NEXT q 165: END SUB 166: 167: SUB ReadPal (Red%, Green%, Blue%) 168: palmask = &H3C6 169: paldata = &H3C9 170: IF INT(Colr% / 2) = Colr% / 2 THEN Red% = INP(paldata): Green% = INP(paldata): Blue% = INP(paldata) 171: Red% = INP(paldata) 172: Green% = INP(paldata) 173: Blue% = INP(paldata) 174: END SUB 175: 176: FUNCTION Rever$ (num) 177: f$ = HEX$(num) 178: f$ = STRING$(4 - LEN(f$), ASC("0")) + f$ 179: Rever$ = CHR$(VAL("&H" + MID$(f$, 3, 2))) + CHR$(VAL("&H" + MID$(f$, 1, 2))) 180: END FUNCTION 181: 182: SUB ShowBitmap (f$, mde) 183: DIM Red AS STRING * 1 184: DIM Green AS STRING * 1 185: DIM Blue AS STRING * 1 186: DIM PicType AS STRING * 1 187: OPEN f$ FOR BINARY AS #1 188: GET #1, 29, PicType 189: mxcol = ASC(PicType) 190: SCREEN 13 191: IF mde = 2 THEN 192: FOR i% = 0 TO 255 193: GET #1, 55 + (i% * 4), Red 194: GET #1, 55 + (i% * 4) + 1, Green 195: GET #1, 55 + (i% * 4) + 2, Blue 196: CCHex1% = INT(ASC(Red)) / 8 197: CCHex2% = INT(ASC(Green)) / 8 198: CCHex3% = INT(ASC(Blue)) / 8 199: ChangePal CCHex3%, CCHex2%, CCHex1%, i% 200: NEXT i% 201: END IF 202: DEF SEG = &HA000 203: DIM v AS STRING * 10000 204: Inc = 10000 205: pt1$ = CHR$(253) + CHR$(0) + CHR$(160) 206: pt2$ = CHR$(VAL("&H" + MID$(FillIn$(HEX$(Inc), 4), 3, 2))) + CHR$(VAL("&H" + MID$(FillIn$(HEX$(Inc), 4), 1, 2))) 207: FOR q = 1079 TO LOF(1) STEP Inc 208: GET #1, q, v 209: OPEN "1.TMP" FOR BINARY AS #3 210: pt3$ = CHR$(VAL("&H" + MID$(FillIn$(HEX$(x1), 4), 3, 2))) + CHR$(VAL("&H" + MID$(FillIn$(HEX$(x1), 4), 1, 2))) 211: PUT #3, , pt1$ 212: PUT #3, , pt3$ 213: PUT #3, , pt2$ 214: PUT #3, , v 215: CLOSE 3 216: BLOAD "1.TMP", x1 217: KILL "1.TMP" 218: x1 = x1 + Inc 219: NEXT q 220: IF mde = 1 THEN 221: FOR i% = 0 TO 255 222: GET #1, 55 + (i% * 4), Red 223: GET #1, 55 + (i% * 4) + 1, Green 224: GET #1, 55 + (i% * 4) + 2, Blue 225: CCHex1% = INT(ASC(Red)) / 8 226: CCHex2% = INT(ASC(Green)) / 8 227: CCHex3% = INT(ASC(Blue)) / 8 228: ChangePal CCHex3%, CCHex2%, CCHex1%, i% 229: NEXT i% 230: END IF 231: CLOSE 1, 2, 3 232: END SUB 233: 234: SUB Solarize (r, g, B) 235: FOR i% = 0 TO 255 236: ReadPal CCHex3%, CCHex2%, CCHex1% 237: ChangePal ABS(CCHex3% - r), ABS(CCHex2% - g), ABS(CCHex1% - B), i% 238: NEXT i% 239: END SUB 240: |