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