1: DECLARE SUB PaletteBar () 2: DECLARE SUB MakeGrid (Acuracy!) 3: DECLARE SUB Solarize (r!, g!, B!) 4: DECLARE SUB Negative () 5: DECLARE SUB Mosaic (sz!) 6: DECLARE SUB ChangePal (Red%, Green%, Blue%, syscolor%) 7: DECLARE SUB ShowBitmap (f$, mde!) 8: DECLARE FUNCTION FillIn$ (t$, num!) 9: DECLARE SUB ReadPal (Red%, Green%, Blue%) 10: DECLARE FUNCTION Exist! (fle$) 11: CLS 12: CLEAR , , 15000 13: '==== All code above the line above this one is ignored ==== 14: CONST mx = 20 15: CONST Bmp$ = "C:\PSP\DEATH1.BMP" 16: ShowBitmap Bmp$, 2 17: 18: SUB ChangePal (Red%, Green%, Blue%, syscolor%) 19: palmask = &H3C6 20: palregrd = &H3CF 21: palregwr = &H3C8 22: paldata = &H3C9 23: OUT palmask, &HFF 24: OUT palregwr, syscolor% 25: OUT paldata, Red% 26: OUT paldata, Green% 27: OUT paldata, Blue% 28: END SUB 29: 30: FUNCTION Exist (fle$) 31: OPEN fle$ FOR BINARY AS #4 32: IF LOF(4) = 0 THEN Exist = 0 ELSE Exist = 1 33: CLOSE 4 34: END FUNCTION 35: 36: FUNCTION FillIn$ (t$, num) 37: FillIn$ = STRING$(num - LEN(t$), ASC("0")) + t$ 38: END FUNCTION 39: 40: SUB MakeGrid (Acuracy) 41: sz = Acuracy 42: FOR x = 0 TO 320 STEP sz 43: FOR y = 0 TO 200 STEP sz 44: c = POINT(x + sz, y) 45: LINE (x, y)-(x + sz - 1, y + sz - 1), c, B 46: NEXT y 47: NEXT x 48: END SUB 49: 50: SUB Mosaic (sz) 51: IF sz <= 1 THEN EXIT SUB 52: FOR x = 0 TO 320 STEP sz 53: FOR y = 0 TO 200 STEP sz 54: c = POINT(x, y) 55: LINE (x, y)-(x + sz - 1, y + sz - 1), c, BF 56: NEXT y 57: NEXT x 58: END SUB 59: 60: SUB Negative 61: Solarize 255, 255, 255 62: END SUB 63: 64: SUB PaletteBar 65: FOR q = 0 TO 255 66: LINE (q, 0)-(q, 8), q 67: NEXT q 68: END SUB 69: 70: SUB ReadPal (Red%, Green%, Blue%) 71: palmask = &H3C6 72: paldata = &H3C9 73: IF INT(Colr% / 2) = Colr% / 2 THEN Red% = INP(paldata): Green% = INP(paldata): Blue% = INP(paldata) 74: Red% = INP(paldata) 75: Green% = INP(paldata) 76: Blue% = INP(paldata) 77: END SUB 78: 79: SUB ShowBitmap (f$, mde) 80: DIM Red AS STRING * 1 81: DIM Green AS STRING * 1 82: DIM Blue AS STRING * 1 83: DIM PicType AS STRING * 1 84: OPEN f$ FOR BINARY AS #1 85: GET #1, 29, PicType 86: mxcol = ASC(PicType) 87: SCREEN 13 88: IF mde = 2 THEN 89: FOR i% = 0 TO 255 90: GET #1, 55 + (i% * 4), Red 91: GET #1, 55 + (i% * 4) + 1, Green 92: GET #1, 55 + (i% * 4) + 2, Blue 93: CCHex1% = INT(ASC(Red)) / 8 94: CCHex2% = INT(ASC(Green)) / 8 95: CCHex3% = INT(ASC(Blue)) / 8 96: ChangePal CCHex3%, CCHex2%, CCHex1%, i% 97: NEXT i% 98: END IF 99: DEF SEG = &HA000 100: DIM v AS STRING * 10000 101: Inc = 10000 102: pt1$ = CHR$(253) + CHR$(0) + CHR$(160) 103: pt2$ = CHR$(VAL("&H" + MID$(FillIn$(HEX$(Inc), 4), 3, 2))) + CHR$(VAL("&H" + MID$(FillIn$(HEX$(Inc), 4), 1, 2))) 104: FOR q = 1079 TO LOF(1) STEP Inc 105: GET #1, q, v 106: OPEN "1.TMP" FOR BINARY AS #3 107: pt3$ = CHR$(VAL("&H" + MID$(FillIn$(HEX$(x1), 4), 3, 2))) + CHR$(VAL("&H" + MID$(FillIn$(HEX$(x1), 4), 1, 2))) 108: PUT #3, , pt1$ 109: PUT #3, , pt3$ 110: PUT #3, , pt2$ 111: PUT #3, , v 112: CLOSE 3 113: BLOAD "1.TMP", x1 114: KILL "1.TMP" 115: x1 = x1 + Inc 116: NEXT q 117: IF mde = 1 THEN 118: FOR i% = 0 TO 255 119: GET #1, 55 + (i% * 4), Red 120: GET #1, 55 + (i% * 4) + 1, Green 121: GET #1, 55 + (i% * 4) + 2, Blue 122: CCHex1% = INT(ASC(Red)) / 8 123: CCHex2% = INT(ASC(Green)) / 8 124: CCHex3% = INT(ASC(Blue)) / 8 125: ChangePal CCHex3%, CCHex2%, CCHex1%, i% 126: NEXT i% 127: END IF 128: CLOSE 1, 2, 3 129: END SUB 130: 131: SUB Solarize (r, g, B) 132: FOR i% = 0 TO 255 133: ReadPal CCHex3%, CCHex2%, CCHex1% 134: ChangePal ABS(CCHex3% - r), ABS(CCHex2% - g), ABS(CCHex1% - B), i% 135: NEXT i% 136: END SUB 137: |