CLS : SCREEN 7, 0, 2, 2
DIM p%(16004), cutpst%(16004), mssub%(100), zoom%(80, 50)
DIM b(1345), a&(16)
DEF SEG = VARSEG(mssub%(0))
OPEN "usemouse.com" FOR BINARY AS #1
WHILE EOF(1) = 0
GET #1, flc% + 1, i%
POKE flc%, i% AND 255
flc% = flc% + 1
WEND
CLOSE #1

DO
a$ = INKEY$
PSET (x, y), oc
GOSUB mouseget
xx = x: yy = y
x = msx: y = msy
IF a$ = " " THEN cc = cc XOR 1
IF a$ = "," THEN c = c - 1
IF a$ = "." THEN c = c + 1
IF a$ = "s" THEN GOSUB save
IF a$ = "b" THEN GOSUB bmpsave
IF a$ = "l" THEN GOSUB load
IF a$ = "h" THEN GOSUB highres
IF a$ = "H" THEN GOSUB highres2
IF a$ = "f" OR msk = 2 THEN PCOPY 2, 3: PAINT (x, y), c
IF a$ = "c" THEN CLS
IF a$ = "7" THEN GOSUB pcut
IF a$ = "8" THEN GOSUB ppaste
IF a$ = "1" THEN PCOPY 2, 3: GOSUB mline
IF a$ = "2" THEN PCOPY 2, 3: GOSUB marc
IF a$ = "3" THEN PCOPY 2, 3: GOSUB mbox
IF a$ = "4" THEN PCOPY 2, 3: GOSUB msbox
IF a$ = "5" THEN PCOPY 2, 3: GOSUB mcircle
IF a$ = "6" THEN PCOPY 2, 3: GOSUB mzoom
IF a$ = "9" THEN GOSUB mtype
IF a$ = "`" THEN PAINT (x, y), c, 0
IF a$ = "o" OR a$ = "O" THEN PCOPY 3, 2
IF a$ = "!" THEN spry% = spry% XOR 1: IF spry% = 1 THEN GOSUB spraywidth
IF a$ = "@" THEN oval% = oval% XOR 1: IF oval% = 1 THEN GOSUB ovalwidth
IF a$ = "#" THEN GOSUB shadow
IF a$ = "$" THEN GOSUB shine
IF a$ = "%" THEN GOSUB inverse
IF a$ = "^" THEN GOSUB shade
IF a$ = "&" THEN GOSUB shine2
IF a$ = "*" THEN GOSUB swivel
IF c < 0 THEN c = 15
IF c > 15 THEN c = 0
LINE (0, 199)-(319, 199), c
IF xx <> x OR yy <> y THEN IF msk = 1 THEN SOUND 37, .1
mmso% = mso%: mso% = 0
IF spry% = 1 AND msk = 1 THEN GOSUB ospray: GOTO nxt2
IF oval% = 1 AND msk = 1 THEN GOSUB ooval: GOTO nxt3
IF a$ = "d" OR cc = 1 OR msk = 1 THEN oc = c: mso% = 1 ELSE oc = POINT(x, y)
IF mso% = 1 AND mmso% = 0 THEN PCOPY 2, 3: SOUND 900, .1
IF cc = 1 OR msk = 1 THEN LINE (xx, yy)-(x, y), c
IF oc < 9 THEN PSET (x, y), 15 ELSE PSET (x, y), 8
nxt2:
FOR a = 1 TO 200: NEXT
nxt3:
LOOP

ospray:
FOR a = 1 TO spwd%
PSET (x + RND * spwd% - (spwd% / 2), y + RND * spwd% - (spwd% / 2)), c
NEXT
RETURN

spraywidth:
SCREEN 7, 0, 1, 1
CLS
INPUT "spraywidth"; spwd%
SCREEN 7, 0, 2, 2
RETURN

ovalwidth:
SCREEN 7, 0, 1, 1
CLS
INPUT "ovalwidth"; ovwd%
SCREEN 7, 0, 2, 2
RETURN

ooval:
ds = ABS(ABS(xx - x) + ABS(yy - y))
xf = 0
yf = 0
FOR a = 1 TO ds
xf = xf + ((xx - x) / ds)
yf = yf + ((yy - y) / ds)
CIRCLE (x + xf, y + yf), ovwd%, c
NEXT
oc = c
RETURN

save:
SCREEN 7, 0, 0, 0
CLS
INPUT "file"; f$
SCREEN 7, 0, 2, 2
GET (0, 0)-(319, 199), p%
DEF SEG = VARSEG(p%(0))
BSAVE f$, 0, 32008
RETURN

load:
SCREEN 7, 0, 0, 0
CLS
INPUT "file"; f$
SCREEN 7, 0, 2, 2
DEF SEG = VARSEG(p%(0))
BLOAD f$, 0
PUT (0, 0), p%, PSET
RETURN

mline:
xx = x: yy = y
PCOPY 2, 0
SCREEN 7, 0, 1, 2
WHILE msk <> 1
PCOPY 0, 1
GOSUB getloc
LINE (xx, yy)-(x, y), c
PCOPY 1, 2
IF a$ = CHR$(27) THEN PCOPY 0, 2: SCREEN 7, 0, 2, 2: RETURN
FOR a = 1 TO 200: NEXT
WEND
SCREEN 7, 0, 2, 2
msk = 0
t = TIMER: WHILE TIMER < t + .1: WEND
RETURN

marc:
xx = x: yy = y
PCOPY 2, 0
SCREEN 7, 0, 1, 2
WHILE msk <> 1
PCOPY 0, 1
GOSUB getloc
GOSUB arc
PCOPY 1, 2
IF msk = 2 THEN d = d XOR 1
IF a$ = CHR$(27) THEN PCOPY 0, 2: SCREEN 7, 0, 2, 2: RETURN
FOR a = 1 TO 200: NEXT
WEND
SCREEN 7, 0, 2, 2
msk = 0
t = TIMER: WHILE TIMER < t + .1: WEND
RETURN

arc:
xn = ABS(xx - x) / 2: yn = ABS(yy - y) / 2
IF xx - x < 0 THEN xm = xn + xx ELSE xm = xn + x
IF yy - y < 0 THEN ym = yn + yy ELSE ym = yn + y
IF xx = x THEN xxx = 3.14159 / 2: xy = 3.14159 * 1.5: GOTO n1
xxx = ATN((yy - y) / (xx - x))
IF xxx > 0 THEN xy = 3.14159 - xxx: xxx = (2 * 3.14159) - xxx ELSE xy = 3.14159 - xxx: xxx = -xxx
xxx = xxx + .00001: xy = xy + .00001
n1:
IF d = 1 THEN CIRCLE (xm, ym), SQR(xn * xn + yn * yn), c, xxx, xy, 1 ELSE CIRCLE (xm, ym), SQR(xn * xn + yn * yn), c, xy, xxx, 1
RETURN

mbox:
xx = x: yy = y
PCOPY 2, 0
SCREEN 7, 0, 1, 2
WHILE msk <> 1
PCOPY 0, 1
GOSUB getloc
LINE (xx, yy)-(x, y), c, B
PCOPY 1, 2
IF a$ = CHR$(27) THEN PCOPY 0, 2: SCREEN 7, 0, 2, 2: RETURN
FOR a = 1 TO 200: NEXT
WEND
SCREEN 7, 0, 2, 2
msk = 0
t = TIMER: WHILE TIMER < t + .1: WEND
RETURN

msbox:
xx = x: yy = y
PCOPY 2, 0
SCREEN 7, 0, 1, 2
WHILE msk <> 1
PCOPY 0, 1
GOSUB getloc
LINE (xx, yy)-(x, y), c, BF
PCOPY 1, 2
IF a$ = CHR$(27) THEN PCOPY 0, 2: SCREEN 7, 0, 2, 2: RETURN
FOR a = 1 TO 200: NEXT
WEND
SCREEN 7, 0, 2, 2
msk = 0
t = TIMER: WHILE TIMER < t + .1: WEND
RETURN

mcircle:
xx = x: yy = y
PCOPY 2, 0
SCREEN 7, 0, 1, 2
WHILE msk <> 1
PCOPY 0, 1
GOSUB getloc
CIRCLE (xx, yy), (ABS(xx - x) + ABS(yy - y)), c
PCOPY 1, 2
SCREEN 7, 0, 2, 2
PSET (x, y), 15
SCREEN 7, 0, 1, 2
IF a$ = CHR$(27) THEN PCOPY 0, 2: SCREEN 7, 0, 2, 2: RETURN
FOR a = 1 TO 200: NEXT
WEND
PCOPY 1, 2
SCREEN 7, 0, 2, 2
msk = 0
t = TIMER: WHILE TIMER < t + .1: WEND
RETURN

mzoom:
PCOPY 2, 0
SCREEN 7, 0, 1, 2
WHILE msk <> 1
PCOPY 0, 1
GOSUB getloc
IF x > 239 THEN x = 239
IF y > 149 THEN y = 149
PSET (msx, msy), 15
LINE (x, y)-(x + 79, y + 49), 15, B
PCOPY 1, 2
WEND
PCOPY 0, 2
SCREEN 7, 0, 2, 2
zx = x: zy = y
FOR x = 0 TO 79
FOR y = 0 TO 49
zoom%(x, y) = POINT(x + zx, y + zy)
NEXT: NEXT
CLS
FOR x = 0 TO 79
FOR y = 0 TO 49
LINE (x * 4, y * 4)-(x * 4 + 3, y * 4 + 3), zoom%(x, y), BF
NEXT: NEXT
oc = POINT(x, y)
WHILE msk <> 2
PSET (x, y), oc
GOSUB getloc
IF a$ = "," THEN c = c - 1
IF a$ = "." THEN c = c + 1
IF a$ = "s" THEN stg% = stg% XOR 1: IF stg% = 1 THEN GOSUB stager
IF c < 0 THEN c = 15
IF c > 15 THEN c = 0
LINE (0, 199)-(319, 199), c
c3 = c
IF stg% = 1 THEN GOSUB colorgt
IF msk = 1 THEN LINE (FIX(x / 4) * 4, FIX(y / 4) * 4)-(FIX(x / 4) * 4 + 3, FIX(y / 4) * 4 + 3), c3, BF: zoom%(FIX(x / 4), FIX(y / 4)) = c3
oc = POINT(x, y)
IF oc < 9 THEN PSET (x, y), 15 ELSE PSET (x, y), 8
FOR a = 1 TO 200: NEXT
WEND
msk = 0
PCOPY 0, 2
FOR x = 0 TO 79
FOR y = 0 TO 49
PSET (x + zx, y + zy), zoom%(x, y)
NEXT: NEXT
RETURN

stager:
SCREEN 7, 0, 1, 1
CLS
INPUT "Color #"; c2
SCREEN 7, 0, 2, 2
RETURN

colorgt:
xc% = ((FIX(x / 4) / 2) * 2) - (FIX(FIX(x / 4) / 2) * 2)
yc% = ((FIX(y / 4) / 2) * 2) - (FIX(FIX(y / 4) / 2) * 2)
IF xc% = 1 AND yc% = 0 THEN c3 = c2
IF xc% = 0 AND yc% = 1 THEN c3 = c2
RETURN

pcut:
PCOPY 2, 0
SCREEN 7, 0, 1, 2
WHILE msk <> 1
PCOPY 0, 1
GOSUB getloc
PSET (msx, msy), 15
LINE (xx, yy)-(x, y), 15, B
IF x < xx THEN x = xx
IF y < yy THEN y = yy
PCOPY 1, 2
WEND
PCOPY 0, 2
SCREEN 7, 0, 2, 2
GET (xx, yy)-(x, y), cutpst%
cdx = ABS(xx - x)
cdy = ABS(yy - y)
msk = 0
t = TIMER: WHILE TIMER < t + .1: WEND
RETURN

ppaste:
PCOPY 2, 0
SCREEN 7, 0, 1, 2
WHILE msk <> 1
PCOPY 0, 1
GOSUB getloc
IF msk = 0 THEN PSET (msx, msy), 15
IF x > 319 - cdx THEN x = 319 - cdx
IF y > 199 - cdy THEN y = 199 - cdy
IF a$ = "," THEN ctmd% = ctmd% - 1
IF a$ = "." THEN ctmd% = ctmd% + 1
IF ctmd% < 1 THEN ctmd% = 4
IF ctmd% > 4 THEN ctmd% = 1
IF ctmd% = 1 THEN PUT (x, y), cutpst%, PSET
IF ctmd% = 2 THEN PUT (x, y), cutpst%, OR
IF ctmd% = 3 THEN PUT (x, y), cutpst%, XOR
IF ctmd% = 4 THEN PUT (x, y), cutpst%, AND
PCOPY 1, 2
WEND
SCREEN 7, 0, 2, 2
msk = 0
t = TIMER: WHILE TIMER < t + .1: WEND
RETURN

mtype:
IF x > 319 - 8 OR y > 199 - 8 THEN RETURN
LOCATE y / 8 + 1, x / 8 + 1
COLOR c
LINE INPUT nule$
COLOR 15
RETURN

getloc:
a$ = INKEY$
GOSUB mouseget
x = msx: y = msy
RETURN

mouseget:
DEF SEG = VARSEG(mssub%(0))
a% = 3: o& = 3: GOSUB pokeloc
CALL absolute(0)
a% = 3: GOSUB peekloc
msx = o& / 2
a% = 5: GOSUB peekloc
msy = o&
a% = 7: GOSUB peekloc
msk = o&
RETURN

pokeloc:
POKE a%, o& AND 255
POKE a% + 1, (o& AND 65280) / 256
RETURN

peekloc:
o& = (PEEK(a%) AND 255)
o& = o& + PEEK(a% + 1) * 256
RETURN

highres:
GET (0, 0)-(319, 199), p%
SCREEN 12, 0, 0, 0
PUT (0, 0), p%
a$ = INPUT$(1)
SCREEN 7, 0, 2, 2
PUT (0, 0), p%
RETURN

highres2:
GET (0, 0)-(319, 199), p%
SCREEN 12, 0, 0, 0
PUT (0, 0), p%
FOR x% = 319 TO 0 STEP -1
FOR y% = 199 TO 0 STEP -1
LINE (x% * 2, y% * 2.4)-(x% * 2 + 1, y% * 2.4 + 3), POINT(x%, y%), BF
NEXT
NEXT
a$ = INPUT$(1)
SCREEN 7, 0, 2, 2
PUT (0, 0), p%
RETURN

bmpsave:
GET (0, 0)-(319, 199), p%
SCREEN 12, 0, 0, 0
PUT (0, 0), p%
FOR x% = 319 TO 0 STEP -1
FOR y% = 199 TO 0 STEP -1
LINE (x% * 2, y% * 2.4)-(x% * 2 + 1, y% * 2.4 + 3), POINT(x%, y%), BF
NEXT
NEXT
i = 0
FOR ic = 0 TO 1
FOR rc = 0 TO 1
FOR gc = 0 TO 1
FOR bc = 0 TO 1
a&(i) = ((rc + ic) * 31) + ((gc + ic) * 31) * 256 + ((bc + ic) * 31) * 65536
i = i + 1
NEXT: NEXT: NEXT: NEXT
PALETTE USING a&(0)
cur = 0
GOSUB savescreen
a$ = INPUT$(1)
SCREEN 7, 0, 2, 2
PUT (0, 0), p%
RETURN

savescreen:
GET (0, 0)-(200, 16), b
LINE (0, 0)-(200, 16), 0, BF
LOCATE 1, 1
c& = a&(cur + 15)
b& = a&(cur)
a&(cur) = 63 + 256 * 63 + 65536 * 63
a&(cur + 15) = 63
PALETTE USING a&(cur)
INPUT "file"; f$
PUT (0, 0), b, PSET
IF f$ = "" THEN RETURN
OPEN f$ FOR OUTPUT AS #1
RESTORE bmpdata
FOR i = 0 TO 53
READ a: PRINT #1, CHR$(a);
NEXT
FOR i = 0 TO 15
PRINT #1, CHR$(((a&(cur + i) AND 65536 * 63) / 65536) * 4);
PRINT #1, CHR$(((a&(cur + i) AND 256 * 63) / 256) * 4);
PRINT #1, CHR$((a&(cur + i) AND 63) * 4);
PRINT #1, CHR$(0);
NEXT
point$ = ""
GET (0, 0)-(10, 479), b
FOR i = 479 TO 0 STEP -1
c = (c + 1) AND 15
LINE (0, 481)-(9, i + 1), c, BF
FOR j = 0 TO 639 STEP 2
point$ = point$ + CHR$(POINT(j, i) * 16 + POINT(j + 1, i))
NEXT
PRINT #1, point$; : point$ = ""
NEXT
CLOSE
PUT (0, 0), b, PSET
a&(cur) = b&
RETURN

shadow:
SCREEN 7, 0, 0, 0
CLS
INPUT "Depth"; sty%
SCREEN 7, 0, 2, 2
FOR x% = 0 TO 319
FOR y% = 199 TO 0 STEP -1
IF POINT(x%, y% + sty%) = c AND POINT(x%, y%) <> c THEN PSET (x%, y% + sty%), POINT(x%, y%) AND 7
NEXT
NEXT
RETURN

shine:
FOR x% = 0 TO 319
FOR y% = 199 TO 0 STEP -1
IF RND * 200 > y% THEN PSET (x%, y%), POINT(x%, y%) OR c
NEXT: NEXT
RETURN

inverse:
FOR x% = 0 TO 319
FOR y% = 199 TO 0 STEP -1
PSET (x%, y%), POINT(x%, y%) XOR 8
NEXT: NEXT
RETURN

shade:
FOR x% = 0 TO 319
FOR y% = 0 TO 199
IF POINT(x% - 1, y% + 1) <> c AND POINT(x%, y%) = c AND POINT(x% - 1, y% + 1) <> (c AND 7) THEN PSET (x%, y%), c AND 7
NEXT: NEXT
RETURN

shine2:
FOR x% = 0 TO 319
FOR y% = 0 TO 199
IF POINT(x% + 1, y% - 1) <> c AND POINT(x%, y%) = c AND POINT(x% + 1, y% - 1) <> 15 THEN PSET (x%, y%), 15
NEXT: NEXT
RETURN

swivel:
FOR x% = 0 TO 319
z = z + .1
FOR y% = 0 TO 199
PSET (x%, y%), POINT(x%, y% + ABS(SIN(z) * 15))
NEXT: NEXT
RETURN

bmpdata:
DATA 66,77,118,88,2,0,0,0
DATA 0,0,118,0,0,0,40,0
DATA 0,0,128,2,0,0,224,1,0
DATA 0,1,0,4,0,0,0,0,0,0
DATA 88,2,0,132,61,0,0,132
DATA 61,0,0,0,0,0,0,0,0,0
DATA 0,0,0,0