DECLARE SUB Negotiate (C!, xy!)
DECLARE SUB UsedPalette (f$, Ignor!)
DECLARE SUB PIClear (s$, n!, dfseg!, CurOff!)
DECLARE FUNCTION SmallestOne! (n1!, n2!)
DECLARE SUB OverLaySrn (Bp$)
DECLARE SUB PaletteBar ()
DECLARE SUB MakeGrid (Acuracy!)
DECLARE SUB Solarize (r!, g!, b!)
DECLARE SUB Negative ()
DECLARE SUB Mosaic (sz!)
DECLARE SUB ChangePal (Red%, Green%, Blue%, syscolor%)
DECLARE SUB ShowBitmap (f$, mde!)
DECLARE FUNCTION FillIn$ (t$, num!)
DECLARE SUB ReadPal (Red%, Green%, Blue%)
DECLARE FUNCTION Exist! (fle$)
CLS
CLEAR , , 15000
'=============================================================================
DIM SHARED UsedPal(0 TO 255)
CONST Bmp$ = "C:\PSP\NEUTRON.BMP"
CONST Bm2$ = "C:\AVI\BMP1.BMP"
ShowBitmap Bmp$, 2
OverLaySrn Bm2$
DO WHILE 1 = 1
SLEEP
Negative
LOOP
END

SUB ChangePal (Red%, Green%, Blue%, syscolor%)
palmask = &H3C6
palregrd = &H3CF
palregwr = &H3C8
paldata = &H3C9
OUT palmask, &HFF
OUT palregwr, syscolor%
OUT paldata, Red%
OUT paldata, Green%
OUT paldata, Blue%
END SUB

FUNCTION Exist (fle$)
OPEN fle$ FOR BINARY AS #4
IF LOF(4) = 0 THEN Exist = 0 ELSE Exist = 1
CLOSE 4
END FUNCTION

FUNCTION FillIn$ (t$, num)
FillIn$ = STRING$(num - LEN(t$), ASC("0")) + t$
END FUNCTION

SUB MakeGrid (Acuracy)
sz = Acuracy
FOR x = 0 TO 320 STEP sz
FOR y = 0 TO 200 STEP sz
C = POINT(x + sz, y)
LINE (x, y)-(x + sz - 1, y + sz - 1), C, B
NEXT y
NEXT x
END SUB

SUB Mosaic (sz)
IF sz <= 1 THEN EXIT SUB
FOR x = 0 TO 320 STEP sz
FOR y = 0 TO 200 STEP sz
C = POINT(x, y)
LINE (x, y)-(x + sz - 1, y + sz - 1), C, BF
NEXT y
NEXT x
END SUB

SUB Negative
Solarize 255, 255, 255
END SUB

SUB Negotiate (C, xy)
DIM TempPal(0 TO 255)
LOCATE 1, 1: PRINT x, y
y = INT(xy / 320)
x = xy MOD 320
FOR q = 0 TO 255
ReadPal r%, g%, b%
TempPal(q) = 65536 * r% + 256 * g% + b%
NEXT q
FOR m = 0 TO 255
IF TempPal(m) > TempPal(C) - 100 AND TempPal(m) < TempPal(C) + 100 THEN PSET (x, y), m: EXIT SUB
NEXT m
END SUB

SUB OverLaySrn (Bp$)
UsedPalette Bp$, 67
DIM Red AS STRING * 1
DIM Green AS STRING * 1
DIM Blue AS STRING * 1

OPEN Bp$ FOR BINARY AS #1
        FOR i% = 0 TO 255
        IF UsedPal(i%) <> 0 THEN
                GET #1, 55 + (i% * 4), Red
                GET #1, 55 + (i% * 4) + 1, Green
                GET #1, 55 + (i% * 4) + 2, Blue
                CCHex1% = INT(ASC(Red)) / 8
                CCHex2% = INT(ASC(Green)) / 8
                CCHex3% = INT(ASC(Blue)) / 8
        ELSE
                ReadPal CCHex3%, CCHex2%, CCHex1%
        END IF
        ChangePal CCHex3%, CCHex2%, CCHex1%, i%
        NEXT i%
CONST Inc = 10000
DIM v AS STRING * Inc
pt1$ = CHR$(253) + CHR$(0) + CHR$(160)
pt3$ = CHR$(VAL("&H" + MID$(FillIn$(HEX$(Inc), 4), 3, 2))) + CHR$(VAL("&H" + MID$(FillIn$(HEX$(Inc), 4), 1, 2)))



DEF SEG = &HA000
FOR q = 1079 TO SmallestOne(LOF(1), (64000) + 1079) STEP Inc
GET #1, q, v
OPEN "1.TMP" FOR BINARY AS #3
pt2$ = CHR$(VAL("&H" + MID$(FillIn$(HEX$(x1), 4), 3, 2))) + CHR$(VAL("&H" + MID$(FillIn$(HEX$(x1), 4), 1, 2)))
PUT #3, , pt1$
PUT #3, , pt2$
PUT #3, , pt3$
PIClear v, 67, &HA000, x1
PUT #3, , v
CLOSE 3
BLOAD "1.TMP", x1
KILL "1.TMP"
x1 = x1 + Inc
NEXT q
CLOSE 1
END SUB

SUB PaletteBar
FOR q = 0 TO 255
LINE (q, 0)-(q, 8), q
NEXT q
END SUB

SUB PIClear (s$, n, DfSg, CurOff)
FOR q = 1 TO LEN(s$)
DEF SEG = DfSg
IF ASC(MID$(s$, q, 1)) = n THEN MID$(s$, q, 1) = CHR$(PEEK(CurOff + q - 1))
IF CurOff + q > 64000 THEN EXIT SUB
NEXT q
END SUB

SUB ReadPal (Red%, Green%, Blue%)
palmask = &H3C6
paldata = &H3C9
IF INT(Colr% / 2) = Colr% / 2 THEN Red% = INP(paldata): Green% = INP(paldata): Blue% = INP(paldata)
Red% = INP(paldata)
Green% = INP(paldata)
Blue% = INP(paldata)
END SUB

SUB ShowBitmap (f$, mde)
DIM Red AS STRING * 1
DIM Green AS STRING * 1
DIM Blue AS STRING * 1
DIM PicType AS STRING * 1
OPEN f$ FOR BINARY AS #1
  GET #1, 29, PicType
mxcol = ASC(PicType)
SCREEN 13
IF mde = 2 THEN
        FOR i% = 0 TO 255
        GET #1, 55 + (i% * 4), Red
        GET #1, 55 + (i% * 4) + 1, Green
        GET #1, 55 + (i% * 4) + 2, Blue
        CCHex1% = INT(ASC(Red)) / 8
        CCHex2% = INT(ASC(Green)) / 8
        CCHex3% = INT(ASC(Blue)) / 8
        ChangePal CCHex3%, CCHex2%, CCHex1%, i%
        NEXT i%
END IF
DEF SEG = &HA000
DIM v AS STRING * 10000
Inc = 10000
pt1$ = CHR$(253) + CHR$(0) + CHR$(160)
pt2$ = CHR$(VAL("&H" + MID$(FillIn$(HEX$(Inc), 4), 3, 2))) + CHR$(VAL("&H" + MID$(FillIn$(HEX$(Inc), 4), 1, 2)))
FOR q = 1079 TO SmallestOne(LOF(1), (64000) + 1079) STEP Inc
GET #1, q, v
OPEN "1.TMP" FOR BINARY AS #3
pt3$ = CHR$(VAL("&H" + MID$(FillIn$(HEX$(x1), 4), 3, 2))) + CHR$(VAL("&H" + MID$(FillIn$(HEX$(x1), 4), 1, 2)))
PUT #3, , pt1$
PUT #3, , pt3$
PUT #3, , pt2$
PUT #3, , v
CLOSE 3
'LOCATE 1, 1: PRINT x1; Inc; LOF(1)
BLOAD "1.TMP", x1
KILL "1.TMP"
x1 = x1 + Inc
NEXT q
IF mde = 1 THEN
        FOR i% = 0 TO 255
        GET #1, 55 + (i% * 4), Red
        GET #1, 55 + (i% * 4) + 1, Green
        GET #1, 55 + (i% * 4) + 2, Blue
        CCHex1% = INT(ASC(Red)) / 8
        CCHex2% = INT(ASC(Green)) / 8
        CCHex3% = INT(ASC(Blue)) / 8
        ChangePal CCHex3%, CCHex2%, CCHex1%, i%
        NEXT i%
END IF
CLOSE 1, 2, 3
END SUB

FUNCTION SmallestOne (n1, n2)
IF n2 < n1 THEN SmallestOne = n2 ELSE SmallestOne = n1
END FUNCTION

SUB Solarize (r, g, b)
        FOR i% = 0 TO 255
        ReadPal CCHex3%, CCHex2%, CCHex1%
        ChangePal ABS(CCHex3% - r), ABS(CCHex2% - g), ABS(CCHex1% - b), i%
        NEXT i%
END SUB

SUB UsedPalette (f$, Ignor)
DIM Dx(1 TO 1) AS STRING * 10000
x = FREEFILE
OPEN f$ FOR BINARY AS #x
FOR q = 1079 TO LOF(x) STEP 10000
GET #1, q, Dx(1)
FOR m = 0 TO 255
IF INSTR(Dx(1), CHR$(m)) <> 0 AND m <> Ignor THEN UsedPal(m) = 1  ': Negotiate m, q
NEXT m
NEXT q
CLOSE x
ERASE Dx
END SUB