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