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