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