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