'$DYNAMIC
'$INCLUDE: 'c:\qb45\qb.bi'
CLS
SCREEN 13
dark% = 15
DIM p%(26002), bckg%(25601), mssub%(100), r%(255), g%(255), B%(255), pl%(15, 15)
DIM rc%(81), gc%(81), bc%(81), cl%(81, 1), rot%(80, 12)
DIM SHARED inregs AS regtype, outregs AS regtype
u$ = CHR$(0) + "H"
d$ = CHR$(0) + "P"
l$ = CHR$(0) + "K"
r$ = CHR$(0) + "M"
FOR rr% = 0 TO 2
FOR gg% = 0 TO 2
FOR bb% = 0 TO 2
FOR ii% = 0 TO 2
x% = 0: y% = 0
aaa% = 0: bbb% = 0
IF rr% > 0 THEN aaa% = aaa% + 4
IF gg% > 0 THEN aaa% = aaa% + 2
IF bb% > 0 THEN aaa% = aaa% + 1
IF ii% > 0 THEN aaa% = aaa% + 8
IF rr% > 1 THEN bbb% = bbb% + 4
IF gg% > 1 THEN bbb% = bbb% + 2
IF bb% > 1 THEN bbb% = bbb% + 1
IF ii% > 1 THEN bbb% = bbb% + 8
cl%(q%, 0) = aaa%
cl%(q%, 1) = bbb%
q% = q% + 1
NEXT: NEXT: NEXT: NEXT
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
FOR a% = 1 TO 255
PALETTE a%, 63 + 256 * 63 + 65536 * 63
r%(a%) = 63
g%(a%) = 63
B%(a%) = 63
NEXT
clg%(0) = 30
clg%(1) = 40
clg%(2) = 45
clg%(3) = 50
clg%(4) = 55
clg%(5) = 63
GOSUB scupdate
GOSUB showmouse
c = 15
DEF SEG = VARSEG(p%(0))
FOR a& = 0 TO 51000
POKE a&, 0
NEXT
main:
GOSUB showmouse
DO
a$ = INKEY$
IF a$ = "`" THEN GOSUB spal
IF a$ = "," THEN c = c - 1
IF a$ = "." THEN c = c + 1
'IF a$ = "`" THEN SCREEN 0: WIDTH 80: SHELL "c:\sc400\cdplay": SCREEN 13: GOSUB updatepal: GOSUB scupdate: GOSUB showmouse
IF a$ = "i" THEN GOSUB inverse
IF a$ = "h" THEN GOSUB half
IF a$ = "\" THEN GOSUB rpal
IF a$ = "1" THEN GOSUB ssave
IF a$ = "2" THEN GOSUB sload
IF a$ = "3" THEN lx% = 0: ly% = 0: GOSUB quad
IF a$ = "4" THEN lx% = 8: ly% = 0: GOSUB quad
IF a$ = "5" THEN lx% = 0: ly% = 8: GOSUB quad
IF a$ = "6" THEN lx% = 8: ly% = 8: GOSUB quad
IF a$ = "f" THEN GOSUB font
IF a$ = "z" AND rrt% > 0 THEN rrt% = rrt% - 1: yc% = 1
IF a$ = "x" AND rrt% < 7 THEN rrt% = rrt% + 1: yc% = 1
IF a$ = "a" AND ggt% > 0 THEN ggt% = ggt% - 1: yc% = 1
IF a$ = "s" AND ggt% < 7 THEN ggt% = ggt% + 1: yc% = 1
IF a$ = "q" AND bbt% > 0 THEN bbt% = bbt% - 1: yc% = 1
IF a$ = "w" AND bbt% < 7 THEN bbt% = bbt% + 1: yc% = 1
IF a$ = "p" THEN paln% = paln% XOR 1
IF c < 0 THEN c = 255
IF c > 255 THEN c = 0
msk = 0
GOSUB mouseget
IF msk = 1 THEN GOSUB click
IF msk = 2 THEN c = POINT(msx - 1, msy): LOCATE 21: PRINT c
IF yc% = 1 THEN yc% = 0: c = ggt% + (FIX(bbt% / 2) * 8) + (rrt% * 32)
FOR a% = 1 TO 8
IF a% > bbt% THEN ci% = 0 ELSE ci% = 24
LINE (50 + (a% * 4), 155)-(52 + (a% * 4), 156), ci%, B

IF a% > ggt% THEN ci% = 0 ELSE ci% = 7
LINE (50 + (a% * 4), 158)-(52 + (a% * 4), 159), ci%, B
IF a% > rrt% THEN ci% = 0 ELSE ci% = 224
LINE (50 + (a% * 4), 161)-(52 + (a% * 4), 162), ci%, B
NEXT
LOCATE 20, 20: PRINT sl% + ch%
LINE (50, 164)-(70, 165), c, B
IF paln% = 1 THEN
pcnt% = pcnt% + 1
IF pcnt% > 30 THEN GOSUB pupd2
END IF
LOOP

spal:
dd% = 15
FOR r% = 0 TO 5
FOR g% = 0 TO 5
FOR B% = 0 TO 5
dd% = dd% + 1
PALETTE dd%, clg%(r%) + clg%(g%) * 256 + clg%(B%) * 65536
r%(dd%) = clg%(r%)
g%(dd%) = clg%(g%)
B%(dd%) = clg%(B%)
NEXT: NEXT: NEXT
RETURN

pupd2:
pcnt% = 0
cl% = cl% + 1
IF cl% > 255 THEN
cl% = 0
IF TIMER > 21600 AND TIMER < 64800 AND dark% < 63 THEN dark% = dark% + 1
IF TIMER > 0 AND TIMER < 21600 AND dark% > 32 THEN dark% = dark% - 1
IF TIMER > 64800 AND dark% > 32 THEN dark% = dark% - 1
END IF
PALETTE cl%, FIX(r%(cl%) * (dark%) / 63) + FIX(g%(cl%) * (dark% / 63)) * 256 + FIX(B%(cl%) * (dark% / 63)) * 65536
RETURN

font:
OPEN "5x7.fnt" FOR OUTPUT AS #1
FOR a% = 0 TO 95
PUT (0, 0), p%(a% * 130), PSET
FOR y% = 0 TO 7
FOR x% = 0 TO 7
cc% = POINT(x%, y%)
IF cc% = 15 AND x% = 0 THEN c% = c% + 128
IF cc% = 15 AND x% = 1 THEN c% = c% + 64
IF cc% = 15 AND x% = 2 THEN c% = c% + 32
IF cc% = 15 AND x% = 3 THEN c% = c% + 16
IF cc% = 15 AND x% = 4 THEN c% = c% + 8
IF cc% = 15 AND x% = 5 THEN c% = c% + 4
IF cc% = 15 AND x% = 6 THEN c% = c% + 2
IF cc% = 15 AND x% = 7 THEN c% = c% + 1
NEXT
c%(y% + 1) = c%
c% = 0
NEXT
WRITE #1, c%(1), c%(2), c%(3), c%(4), c%(5), c%(6), c%(7), c%(8)
c$ = ""
NEXT
CLOSE #1
RETURN

rpal:
cc% = 0
FOR r% = 0 TO 7
FOR B% = 0 TO 3
FOR g% = 0 TO 7
r%(cc%) = r% * 9
g%(cc%) = g% * 9
B%(cc%) = B% * 21
cc% = cc% + 1
NEXT: NEXT: NEXT
GOSUB updatepal
RETURN

quad:
FOR x% = lx% TO lx% + 8
FOR y% = ly% TO ly% + 8
pl%(x% - lx%, y% - ly%) = POINT(x% + 145, y% + 9)
NEXT: NEXT
FOR x% = 0 TO 15
FOR y% = 0 TO 15
PSET (x% + 145, y% + 9), pl%(x% / 2, y% / 2)
NEXT: NEXT
GOSUB gupdate
RETURN

inverse:
FOR i = 1 TO 0 STEP -.1
FOR a = 0 TO 255
PALETTE a, FIX(r%(a) * i) + FIX(g%(a) * i) * 256 + FIX(B%(a) * i) * 65536
NEXT
NEXT
RETURN

half:
FOR a% = 0 TO 199
PUT (0, 0), p%(a% * 130), PSET
FOR x% = 0 TO 7
FOR y% = 0 TO 7
pl%(x%, y%) = POINT(x% * 2, y% * 2)
NEXT: NEXT
FOR x% = 0 TO 7
FOR y% = 0 TO 7
PSET (x%, y%), pl%(x%, y%)
NEXT: NEXT
GET (0, 0)-(15, 15), p%(a% * 130)
NEXT
RETURN

ssave:
DEF SEG = VARSEG(bckg%(0))
FOR a% = 0 TO 199
PUT (0, 0), p%(a% * 130), PSET
FOR x% = 0 TO 15
FOR y% = 0 TO 15
POKE (a% * 256&) + (y% * 16&) + x%, POINT(x%, y%)
NEXT: NEXT
NEXT
BSAVE "war.pic", 0, 51201
RETURN

sload:
DEF SEG = VARSEG(bckg%(0))
BLOAD "war.pic", 0
FOR a% = 0 TO 199
FOR x% = 0 TO 15
FOR y% = 0 TO 15
PSET (x%, y%), PEEK((a% * 256&) + (y% * 16&) + x%) AND 255
NEXT: NEXT
GET (0, 0)-(15, 15), p%(a% * 130)
NEXT
RETURN

click:
IF msy <= 7 THEN GOSUB pulldown: RETURN
IF msx > 15 AND msy > 7 AND msx < 144 AND msy < 136 THEN GOSUB dot: RETURN
IF msy > 143 AND msy < 152 AND msx < 49 THEN GOSUB scupdate: RETURN
IF msy > 151 AND msy < 159 AND msx < 49 THEN GOSUB copyi: RETURN
IF msy > 192 THEN GOSUB bar: RETURN
IF msy > 174 AND msy < 191 AND msx < 289 THEN GOSUB barbox: RETURN
IF msx > 144 AND msy > 8 AND msx < 161 AND msy < 106 THEN GOSUB copyb: RETURN
RETURN

pulldown:
IF msx >= 0 AND msx <= 7 THEN GOSUB about: RETURN
IF msx >= 8 AND msx <= 71 THEN GOSUB file: RETURN
IF msx >= 72 AND msx <= 141 THEN GOSUB cpalette: RETURN
IF msx >= 142 THEN GOSUB options: RETURN
RETURN

file:
GOSUB hidemouse
GET (8, 7)-(113, 47), bckg%
LINE (8, 7)-(113, 47), 0, BF
LOCATE 2, 2: PRINT "(N)ew"
LOCATE 3, 2: PRINT "(L)oad"
LOCATE 4, 2: PRINT "(S)ave"
LOCATE 5, 2: PRINT "Save (a)s..."
LOCATE 6, 2: PRINT "E(x)it"
LINE (8, 7)-(113, 47), 15, B
GOSUB showmouse
WHILE msk = 1
GOSUB mouseget
WEND
GOSUB hidemouse
PUT (8, 7), bckg%, PSET
GOSUB showmouse
IF msx < 8 OR msx > 113 OR msy < 7 OR msy > 47 THEN RETURN
ON FIX(msy / 8) GOSUB newf, loadf, savef, saveasf, exitf
RETURN

newf:
GOSUB checkchange
GOSUB clearbl
GOSUB scupdate
f$ = ""
RETURN

loadf:
GOSUB checkchange
GOSUB hidemouse
GET (0, 87)-(319, 96), bckg%
LINE (0, 87)-(319, 96), 15, B
VIEW PRINT 12 TO 12
LOCATE 12, 2
INPUT "File"; f$
VIEW PRINT
DEF SEG = VARSEG(p%(0))
BLOAD f$, 0
DEF SEG
GOSUB scupdate
PUT (0, 95), bckg%, PSET
GOSUB showmouse
RETURN

savef:
GOSUB hidemouse
GET (0, 87)-(319, 96), bckg%
LINE (0, 87)-(319, 96), 15, B
VIEW PRINT 12 TO 12
LOCATE 12, 2
IF f$ = "" THEN INPUT "File"; f$
VIEW PRINT
DEF SEG = VARSEG(p%(0))
BSAVE f$, 0, 52001
DEF SEG
GOSUB scupdate
PUT (0, 87), bckg%, PSET
GOSUB showmouse
RETURN

saveasf:
GOSUB hidemouse
GET (0, 87)-(319, 96), bckg%
LINE (0, 87)-(319, 96), 15, B
VIEW PRINT 12 TO 12
LOCATE 12, 2
INPUT "File"; f$
VIEW PRINT
DEF SEG = VARSEG(p%(0))
BSAVE f$, 0, 52001
DEF SEG
GOSUB scupdate
PUT (0, 87), bckg%, PSET
GOSUB showmouse
RETURN

exitf:
GOSUB checkchange
END

cpalette:
GOSUB hidemouse
GET (88, 7)-(193, 47), bckg%
LINE (88, 7)-(193, 47), 0, BF
LOCATE 2, 12: PRINT "A(d)just"
LOCATE 3, 12: PRINT "Da(r)k-Bright"
LOCATE 4, 12: PRINT "(M)ix"
LOCATE 5, 12: PRINT "Save"
LOCATE 6, 12: PRINT "Load"
LINE (88, 7)-(193, 47), 15, B
GOSUB showmouse
WHILE msk = 1
GOSUB mouseget
WEND
GOSUB hidemouse
PUT (88, 7), bckg%, PSET
GOSUB showmouse
IF msx < 88 OR msx > 193 OR msy < 7 OR msy > 47 THEN RETURN
ON FIX(msy / 8) GOSUB adjust, darkbright, mix, psave, pload
RETURN

adjust:
GOSUB hidemouse
GET (79, 79)-(241, 111), bckg%
LINE (79, 79)-(241, 111), 0, BF
LINE (79, 79)-(241, 111), 15, B
LINE (80, 104)-(240, 110), c, BF
GOSUB showmouse
LOCATE 11, 18: PRINT "-  +"
LOCATE 12, 18: PRINT "-  +  Done"
LOCATE 13, 18: PRINT "-  +"
DO
GOSUB mouseget
IF msk <> 0 THEN
IF msx >= 136 AND msx <= 136 + 7 AND msy >= 80 AND msy <= 80 + 7 THEN r%(c) = r%(c) - 1: GOSUB adj
IF msx >= 160 AND msx <= 160 + 7 AND msy >= 80 AND msy <= 80 + 7 THEN r%(c) = r%(c) + 1: GOSUB adj
IF msx >= 136 AND msx <= 136 + 7 AND msy >= 88 AND msy <= 88 + 7 THEN g%(c) = g%(c) - 1: GOSUB adj
IF msx >= 160 AND msx <= 160 + 7 AND msy >= 88 AND msy <= 88 + 7 THEN g%(c) = g%(c) + 1: GOSUB adj
IF msx >= 136 AND msx <= 136 + 7 AND msy >= 96 AND msy <= 96 + 7 THEN B%(c) = B%(c) - 1: GOSUB adj
IF msx >= 160 AND msx <= 160 + 7 AND msy >= 96 AND msy <= 96 + 7 THEN B%(c) = B%(c) + 1: GOSUB adj
IF msx >= 176 AND msx <= 176 + 40 AND msy >= 88 AND msy <= 88 + 7 THEN GOTO doneadj
END IF
LOOP
doneadj:
GOSUB hidemouse
PUT (79, 79), bckg%, PSET
GOSUB showmouse
RETURN

adj:
IF r%(c) < 0 THEN r%(c) = 0
IF r%(c) > 63 THEN r%(c) = 63
IF g%(c) < 0 THEN g%(c) = 0
IF g%(c) > 63 THEN g%(c) = 63
IF B%(c) < 0 THEN B%(c) = 0
IF B%(c) > 63 THEN B%(c) = 63
PALETTE c, r%(c) + (g%(c) * 256) + (B%(c) * 65536)
LOCATE 11, 11: PRINT "Rd"; r%(c)
LOCATE 12, 11: PRINT "Gn"; g%(c)
LOCATE 13, 11: PRINT "Bl"; B%(c)
IF msk = 1 THEN t = TIMER: WHILE TIMER < t + .1: WEND
RETURN

darkbright:
msk = 0
WHILE msk = 0
GOSUB mouseget
WEND
c2 = POINT(msx, msy - 1)
c2 = c2 - 2
IF c2 > c THEN RETURN
FOR a = 2 TO (c - c2) - 1
r%(a + c2) = (a / ((c - c2))) * r%(c)
g%(a + c2) = (a / ((c - c2))) * g%(c)
B%(a + c2) = (a / ((c - c2))) * B%(c)
PALETTE a + c2, r%(a + c2) + g%(a + c2) * 256 + B%(a + c2) * 65536
NEXT
RETURN

mix:
msk = 0
WHILE msk = 0
GOSUB mouseget
WEND
c2 = POINT(msx, msy - 1)
t = TIMER: WHILE TIMER < t + .5: WEND
msk = 0
WHILE msk = 0
GOSUB mouseget
WEND
c3 = POINT(msx, msy - 1)
r%(c3) = (r%(c) + r%(c2)) / 2
g%(c3) = (g%(c) + g%(c2)) / 2
B%(c3) = (B%(c) + B%(c2)) / 2
PALETTE c3, r%(c3) + g%(c3) * 256 + B%(c3) * 65536
RETURN

psave:
GOSUB hidemouse
GET (0, 87)-(319, 96), bckg%
LINE (0, 87)-(319, 96), 15, B
VIEW PRINT 12 TO 12
LOCATE 12, 2
INPUT "File"; pf$
VIEW PRINT
PUT (0, 87), bckg%, PSET
OPEN pf$ FOR BINARY AS #1
rc% = 0
FOR a% = 0 TO 255
rc% = rc% + 1: PUT #1, rc%, r%(a%)
rc% = rc% + 1: PUT #1, rc%, g%(a%)
rc% = rc% + 1: PUT #1, rc%, B%(a%)
NEXT
CLOSE #1
GOSUB scupdate
GOSUB showmouse
RETURN

pload:
GOSUB hidemouse
GET (0, 87)-(319, 96), bckg%
LINE (0, 87)-(319, 96), 15, B
VIEW PRINT 12 TO 12
LOCATE 12, 2
INPUT "File"; pf$
VIEW PRINT
PUT (0, 87), bckg%, PSET
OPEN pf$ FOR BINARY AS #1
rc% = 0
FOR a% = 0 TO 255
rc% = rc% + 1: GET #1, rc%, r%(a%)
rc% = rc% + 1: GET #1, rc%, g%(a%)
rc% = rc% + 1: GET #1, rc%, B%(a%)
r%(a%) = r%(a%) AND 255
g%(a%) = g%(a%) AND 255
B%(a%) = B%(a%) AND 255
NEXT
CLOSE #1
GOSUB updatepal
GOSUB scupdate
GOSUB showmouse
RETURN

updatepal:
FOR a% = 0 TO 255
PALETTE a%, r%(a%) + g%(a%) * 256 + B%(a%) * 65536
NEXT
RETURN

options:
GOSUB hidemouse
GET (142, 7)-(247, 88), bckg%
LINE (142, 7)-(247, 88), 0, BF
LOCATE 2, 19: PRINT "Pseudo sprite"
LOCATE 3, 19: PRINT "16 color Save"
LOCATE 4, 19: PRINT "Full scrn drw"
LOCATE 5, 19: PRINT "Color swap"
LOCATE 6, 19: PRINT "Flip LR"
LOCATE 7, 19: PRINT "Flip UD"
LOCATE 8, 19: PRINT "Color / Block"
LOCATE 9, 19: PRINT "Rotate 90�"
LOCATE 10, 19: PRINT "Rotate 10�"
LOCATE 11, 19: PRINT "Cnvrt 24B BMP"
LINE (142, 7)-(247, 88), 15, B
GOSUB showmouse
WHILE msk = 1
GOSUB mouseget
WEND
GOSUB hidemouse
PUT (142, 7), bckg%, PSET
GOSUB showmouse
IF msx < 142 OR msx > 247 OR msy < 7 OR msy > 88 THEN RETURN
ON FIX(msy / 8) GOSUB psprite, s16color, drawi, cswap, fliplr, flipud, colorforblock, rotate, rot2, cbmp
RETURN

psprite:
GOSUB hidemouse
FOR x% = 0 TO 15
FOR y% = 0 TO 15
IF POINT(x% + 145, y% + 9) = 0 THEN PSET (x% + 145, y% + 9), 255 ELSE PSET (x% + 145, y% + 9), 0
NEXT: NEXT
GOSUB gupdate
GOSUB showmouse
RETURN

s16color:
FOR a% = 0 TO 199
SCREEN 13
PUT (0, 0), p%(a% * 130), PSET
FOR x% = 0 TO 15
FOR y% = 0 TO 15
pl%(x%, y%) = POINT(x%, y%)
NEXT: NEXT
SCREEN 7
FOR x% = 0 TO 15
FOR y% = 0 TO 15
bbb% = r%(pl%(x%, y%))
ggg% = g%(pl%(x%, y%))
rrr% = B%(pl%(x%, y%))
ii% = 0: gg% = 0: bb% = 0: rr% = 0
clse% = 500
FOR rc% = 0 TO 2
FOR gc% = 0 TO 2
FOR bc% = 0 TO 2
FOR ic% = 0 TO 2
bc2% = (rc% * 21) + (ic% * 10)
gc2% = (gc% * 21) + (ic% * 10)
rc2% = (bc% * 21) + (ic% * 10)
dst% = ABS(rrr% - rc2%) + ABS(ggg% - gc2%) + ABS(bbb% - bc2%)
IF dst% < clse% THEN rc3% = rc%: gc3% = gc%: bc3% = bc%: ic3% = ic%: clse% = dst%
NEXT: NEXT: NEXT: NEXT
c% = 0
cfg% = (x% + y%) AND 1
IF rc3% = 2 THEN c% = c% + 4 ELSE IF rc3% = 1 AND cfg% = 1 THEN c% = c% + 4
IF gc3% = 2 THEN c% = c% + 2 ELSE IF gc3% = 1 AND cfg% = 1 THEN c% = c% + 2
IF bc3% = 2 THEN c% = c% + 1 ELSE IF bc3% = 1 AND cfg% = 1 THEN c% = c% + 1
IF ic3% = 2 THEN c% = c% + 8 ELSE IF ic3% = 1 AND cfg% = 1 THEN c% = c% + 8
PSET (x%, y%), c%
NEXT: NEXT
GET (0, 0)-(15, 15), bckg%(a% * 66)
NEXT
SCREEN 13
DEF SEG = VARSEG(bckg%(0))
INPUT "Name"; f$
BSAVE f$, 0, 26205
DEF SEG
GOSUB scupdate
RETURN

cswap:
msk = 0
WHILE msk = 0
GOSUB mouseget
WEND
GOSUB hidemouse
c2 = POINT(msx, msy)
FOR x% = 0 TO 15
FOR y% = 0 TO 15
IF POINT(x% + 145, y% + 9) = c THEN PSET (x% + 145, y% + 9), c2
NEXT: NEXT
GOSUB gupdate
GOSUB showmouse
RETURN

fliplr:
GOSUB hidemouse
FOR x% = 0 TO 15
FOR y% = 0 TO 15
pl%(x%, y%) = POINT(x% + 145, y% + 9)
NEXT: NEXT
FOR x% = 0 TO 15
FOR y% = 0 TO 15
PSET (x% + 145, y% + 9), pl%(15 - x%, y%)
NEXT: NEXT
GOSUB gupdate
GOSUB showmouse
RETURN

flipud:
GOSUB hidemouse
FOR x% = 0 TO 15
FOR y% = 0 TO 15
pl%(x%, y%) = POINT(x% + 145, y% + 9)
NEXT: NEXT
FOR x% = 0 TO 15
FOR y% = 0 TO 15
PSET (x% + 145, y% + 9), pl%(x%, 15 - y%)
NEXT: NEXT
GOSUB gupdate
GOSUB showmouse
RETURN

colorforblock:
GOSUB hidemouse
PUT (0, 0), p%((ch% + sl%) * 130), PSET
FOR x% = 0 TO 15
FOR y% = 0 TO 15
IF POINT(x% + 145, y% + 9) = c THEN PSET (x% + 145, y% + 9), POINT(x%, y%)
NEXT: NEXT
GOSUB gupdate
GOSUB showmouse
RETURN

rotate:
GOSUB hidemouse
FOR x% = 0 TO 15
FOR y% = 0 TO 15
pl%(x%, y%) = POINT(x% + 145, y% + 9)
NEXT: NEXT
FOR x% = 0 TO 15
FOR y% = 0 TO 15
PSET ((15 - y%) + 145, x% + 9), pl%(x%, y%)
NEXT: NEXT
GOSUB gupdate
GOSUB showmouse
RETURN

rot2:
GOSUB hidemouse
FOR d% = 0 TO 12
FOR r% = 0 TO 40
rot%(r%, d%) = POINT(152 + (SIN(r% / 6.36) * d%), 16 + (COS(r% / 6.36) * d%))
NEXT: NEXT
a$ = "": rrt = 0
WHILE a$ <> CHR$(13)
a$ = INKEY$
IF a$ = "," THEN rrt = rrt + (6.28 / 16)
IF a$ = "." THEN rrt = rrt - (6.28 / 16)
FOR d% = 0 TO 12
FOR r% = 0 TO 60
PSET (152 + (SIN((r% / 6.36) - rrt) * d%), 16 + (COS((r% / 6.36) - rrt) * d%)), rot%(r%, d%)
NEXT: NEXT
WEND
GOSUB gupdate
GOSUB showmouse
RETURN

cbmp:
GOSUB hidemouse
CLS
LOCATE 10: INPUT "24Bit .BMP file"; f$
DEF SEG = &HA000
BLOAD f$, 0
DEF SEG
GOTO getblocks
OPEN f$ FOR BINARY AS #1
fl& = 55
FOR y% = 0 TO 199
FOR x% = 0 TO 319
GET #1, fl&, bt1%
GET #1, fl& + 1, gt1%
GET #1, fl& + 2, rt1%
bbt% = (bt1% AND 255) / 35
rrt% = (rt1% AND 255) / 35
ggt% = (gt1% AND 255) / 35
PSET (x%, (200 - y%)), ggt% + (FIX(bbt% / 2) * 8) + (rrt% * 32)
fl& = fl& + 3
NEXT: NEXT
CLOSE #1
GET (0, 0)-(319, 8), bckg%
LOCATE 1: PRINT "1) Save 2) Edit 3) Get blocks"
a$ = INPUT$(1)
PUT (0, 0), bckg%, PSET
IF a$ = "1" THEN GOSUB save8bm
IF a$ = "2" THEN GOSUB drawi
IF a$ = "3" THEN GOSUB getblocks
GOSUB showmouse
RETURN

cbmp2:
GOSUB hidemouse
CLS
LOCATE 10: INPUT "24Bit .BMP file"; f$
OPEN f$ FOR BINARY AS #1
fl& = 55
FOR y% = 0 TO 199
FOR x% = 0 TO 319
GET #1, fl&, bt1%
GET #1, fl& + 1, gt1%
GET #1, fl& + 2, rt1%
bbt% = (bt1% AND 255) / 35
rrt% = (rt1% AND 255) / 35
ggt% = (gt1% AND 255) / 35
PSET (x%, (200 - y%)), ggt% + (FIX(bbt% / 2) * 8) + (rrt% * 32)
fl& = fl& + 3
NEXT: NEXT
CLOSE #1
GET (0, 0)-(319, 8), bckg%
LOCATE 1: PRINT "1) Save 2)Edit 3)Get blocks"
a$ = INPUT$(1)
PUT (0, 0), bckg%, PSET
IF a$ = "1" THEN GOSUB save8bm
IF a$ = "2" THEN GOSUB drawi
IF a$ = "3" THEN GOSUB getblocks
GOSUB showmouse
RETURN

getblocks:
DO
msk = 0
WHILE msk <> 1
FOR a% = 0 TO 400: NEXT
PSET (x, y), cc2
GOSUB mouseget
x = msx: y = msy
cc2 = POINT(x, y)
PSET (x, y), 15
WEND
t# = TIMER: WHILE TIMER < t# + 1: WEND
msk = 0
x2 = x: y2 = y
WHILE msk <> 1
FOR a% = 0 TO 400: NEXT
PSET (x, y), cc2
PSET (x, y2), cc3
PSET (x2, y), cc4
PSET (x2, y2), cc5
GOSUB mouseget
x = msx: y = msy
cc2 = POINT(x, y): cc3 = POINT(x, y2): cc4 = POINT(x2, y): cc5 = POINT(x2, y2)
PSET (x, y), 15
PSET (x, y2), 15
PSET (x2, y), 15
PSET (x2, y2), 15
WEND
PSET (x, y), cc2
PSET (x, y2), cc3
PSET (x2, y), cc4
PSET (x2, y2), cc5
t# = TIMER: WHILE TIMER < t# + 1: WEND
GET (0, 0)-(319, 8), bckg%
LOCATE 1: PRINT "Use this as block (Y/N;Q=Quit)"
a$ = INPUT$(1)
PUT (0, 0), bckg%, PSET
IF a$ = "Y" OR a$ = "y" THEN GOSUB ubl
IF a$ = "q" OR a$ = "Q" THEN GOSUB showmouse: RETURN
LOOP

ubl:
GET (0, 0)-(319, 8), bckg%
LOCATE 1: INPUT "block number"; bn%
PUT (0, 0), bckg%, PSET
GET (0, 0)-(15, 15), bckg%
xe = (x2 - x) / 15
ye = (y2 - y) / 15
FOR xd% = 0 TO 15
FOR yd% = 0 TO 15
PSET (15 - xd%, 15 - yd%), POINT((xd% * xe) + x, (yd% * ye) + y)
NEXT: NEXT
GET (0, 0)-(15, 15), p%(bn% * 130)
PUT (0, 0), bckg%, PSET
LINE (x, y)-(x2, y2), 0, BF
RETURN

save8bm:
GET (0, 0)-(319, 8), bckg%
g$ = ""
FOR a% = 1 TO LEN(f$) - 4
g$ = g$ + MID$(f$, a%, 1)
NEXT
f$ = g$
f$ = g$ + ".8bm"
LOCATE 1: PRINT "Save as"; f$; "(Y/N)"
a$ = INPUT$(1)
PUT (0, 0), bckg%, PSET
IF a$ = "n" OR a$ = "N" THEN
GET (0, 0)-(319, 8), bckg%
LOCATE 1: INPUT "File"; f$
PUT (0, 0), bckg%, PSET
END IF
DEF SEG = &HA000
BSAVE f$, 0, &HFFFF
DEF SEG
RETURN

about:
GOSUB hidemouse
GET (0, 87)-(319, 104), bckg%
LINE (0, 87)-(319, 104), 15, B
LOCATE 12, 8: PRINT "Graphics Development Pack"
LOCATE 13, 8: PRINT "1994 �ibbleware(v1.00.03)"
GOSUB showmouse
msk = 0
WHILE msk = 0 OR msy < 87 OR msy > 104
GOSUB mouseget
WEND
GOSUB hidemouse
PUT (0, 87), bckg%, PSET
GOSUB showmouse
RETURN

dot:
x% = ((msx - 20) / 8)
y% = ((msy - 12) / 8)
IF POINT(x% + 145, y% + 9) = c THEN RETURN
GOSUB hidemouse
PSET (x% + 145, y% + 9), c
LINE ((x% * 8) + 17, (y% * 8) + 9)-((x% * 8) + 23, (y% * 8) + 15), c, BF
GOSUB showmouse
RETURN

bar:
GOSUB hidemouse
IF msx < 8 AND ch% > 0 THEN ch% = ch% - 1
IF msx > 311 AND ch% < 182 THEN ch% = ch% + 1
GOSUB barupdate
GOSUB showmouse
RETURN

barbox:
GOSUB hidemouse
ssl% = sl%
sl% = msx / 17
GOSUB barupdate
GOSUB showmouse
IF ch% + sl% <> imed% THEN lbl% = imed%: imed% = ch% + sl%
RETURN

copyi:
GOSUB hidemouse
DEF SEG = VARSEG(p%(0))
FOR xx% = 0 TO 15
FOR yy% = 0 TO 15
POKE ((ch% + sl%) * 256) + yy% * 16 + xx%, POINT(145 + xx%, 9 + yy%)
NEXT: NEXT
GOSUB barupdate
GOSUB showmouse
RETURN

copyb:
GOSUB hidemouse
FOR xx% = 0 TO 15
FOR yy% = 0 TO 15
PSET (145 + xx%, 9 + yy%), PEEK(((ch% + sl%) * 256) + yy% * 16 + xx%)
NEXT: NEXT
GOSUB gupdate
GOSUB barupdate
GOSUB showmouse
RETURN

gupdate:
FOR x% = 0 TO 15
FOR y% = 0 TO 15
LINE ((x% * 8) + 17, (y% * 8) + 9)-((x% * 8) + 23, (y% * 8) + 15), POINT(x% + 145, y% + 9), BF
NEXT: NEXT
RETURN

clearbl:
GET (0, 0)-(15, 15), bckg%
LINE (0, 0)-(15, 15), 0, BF
FOR a% = 0 TO 199
GET (0, 0)-(15, 15), p%(a% * 130)
NEXT
PUT (0, 0), bckg%, PSET
RETURN

scupdate:
GOSUB hidemouse
CLS
LOCATE 1: PRINT "� File    Palette   Options"
LINE (144, 8)-(161, 25), 15, B
FOR x% = 0 TO 16
LINE (16, (x% * 8) + 8)-(144, (x% * 8) + 8), 15
LINE ((x% * 8) + 16, 8)-((x% * 8) + 16, 136), 15
NEXT
LOCATE 19: PRINT "CLEAR"
LOCATE 20: PRINT "COPY"
ccc% = 0
FOR x% = 0 TO 15
FOR y% = 0 TO 15
LINE (x% * 8 + 162, y% * 8 + 8)-(x% * 8 + 168, y% * 8 + 14), ccc%, BF
ccc% = ccc% + 1
NEXT: NEXT
LOCATE 25: PRINT "<";
LOCATE 25, 40: PRINT ">";
GOSUB showmouse
RETURN

barupdate:
DEF SEG = VARSEG(p%(0))
FOR a% = 0 TO 17
FOR xx% = 0 TO 15
FOR yy% = 0 TO 15
PSET (xx% + (a% * 17) + 1, yy% + 175), PEEK(((a% + ch%) * 256) + yy% * 16 + xx%)
NEXT: NEXT
NEXT
LINE (ssl% * 17, 174)-(ssl% * 17 + 17, 192), 0, B
LINE (sl% * 17, 174)-(sl% * 17 + 17, 192), 15, B
RETURN

checkchange:
RETURN

drawi:
ccc% = 0
CLS
GOSUB hidemouse
a$ = ""
WHILE a$ <> "q" AND a$ <> "Q"
a$ = "": WHILE a$ = "" AND ms = 0: a$ = INKEY$: WEND
IF ms = 1 THEN a$ = INKEY$
PSET (x, y), oc
PSET (x, y - 1), cc2
PSET (x + 1, y), cc3
PSET (x, y + 1), cc4
PSET (x - 1, y), cc5
IF a$ = CHR$(27) THEN ms = ms XOR 1
IF a$ = "w" THEN ww = ww XOR 1
IF a$ = u$ OR a$ = "i" THEN IF y > 0 THEN y = y - 1
IF a$ = d$ OR a$ = "m" THEN IF y < 199 THEN y = y + 1
IF a$ = l$ OR a$ = "j" THEN IF x > 0 THEN x = x - 1
IF a$ = r$ OR a$ = "k" THEN IF x < 319 THEN x = x + 1
mms = msk
IF ms = 1 THEN xx = msx: yy = msy
IF ms = 1 THEN GOSUB mouseget: x = msx: y = msy
IF ms = 1 AND msk = 1 AND mms = 0 THEN xx = msx: yy = msy
IF a$ = "`" THEN GOSUB btot
IF a$ = "a" THEN GOSUB fuzz
IF a$ = "S" OR a$ = "s" THEN GOSUB saveh
IF a$ = "L" OR a$ = "l" THEN GOSUB loadh
IF a$ = "f" OR a$ = "F" THEN PAINT (x, y), c
IF a$ = " " THEN cc = cc XOR 1
IF a$ = "," THEN c = c - 1
IF a$ = "." THEN c = c + 1
IF msk = 2 OR a$ = "c" OR a$ = "c" THEN c = POINT(x, y)
IF c < 0 THEN c = 255
IF c > 255 THEN c = 0
IF ms = 1 AND msk = 1 THEN a$ = "d": LINE (xx, yy)-(x, y), c
ppo = 0
IF cc = 1 OR a$ = "d" OR a$ = "D" THEN oc = c: ppo = 1 ELSE oc = POINT(x, y)
cc2 = POINT(x, y - 1): cc3 = POINT(x + 1, y): cc4 = POINT(x, y + 1): cc5 = POINT(x - 1, y)
IF ppo = 1 AND ww = 1 THEN cc2 = c: cc3 = c: cc4 = c: cc5 = c
PSET (x, y), 15
PSET (x, y - 1), 0
PSET (x + 1, y), 0
PSET (x, y + 1), 0
PSET (x - 1, y), 0
LINE (0, 199)-(319, 199), c

WEND
CLS
GOSUB showmouse
RETURN

saveh:
GET (0, 0)-(319, 8), bckg%
LOCATE 1: INPUT "file"; f$
PUT (0, 0), bckg%, PSET
DEF SEG = &HA000
BSAVE f$, VARPTR(p%(0)), &HFFFF
DEF SEG
RETURN

loadh:
LOCATE 1: INPUT "file"; f$
DEF SEG = &HA000
BLOAD f$, 0
DEF SEG
PUT (0, 0), p%, PSET
RETURN

btot:
FOR a = 0 TO 100
LINE (0, a)-(319, a), (a / 1.5873) + c
NEXT
FOR a = 0 TO 100
LINE (0, a + 101)-(319, a + 101), ((100 - a) / 1.5873) + c
NEXT
RETURN

fuzz:
FOR x% = 0 TO 319
FOR y% = 0 TO 199
PSET (x%, y%), RND * 15 + 16
NEXT: NEXT
RETURN

mouseget:
inregs.ax = 3
CALL interrupt(&H33, inregs, outregs)
msx = outregs.cx / 2
msy = outregs.dx
msk = outregs.bx
RETURN

showmouse:
inregs.ax = 1
CALL interrupt(&H33, inregs, outregs)
RETURN

hidemouse:
inregs.ax = 2
CALL interrupt(&H33, inregs, outregs)
RETURN

errhndle:
GOSUB hidemouse
GET (0, 87)-(319, 104), bckg%
LINE (0, 87)-(319, 104), 15, B
LOCATE 12, 14: PRINT "ERROR!"
LOCATE 13: PRINT "File not found"
GOSUB showmouse
msk = 0
a$ = INPUT$(1)
GOSUB hidemouse
PUT (0, 87), bckg%, PSET
GOSUB showmouse
CLS
GOSUB scupdate
RESUME main

DATA 28,7,194,8,95,23,183,22,105,34,39,52,207,57,226,82,58,77,75,93,92,109,118,121,254,110,275,151,269,169,167,81,158,60,202,76,202,91,211,106,223,121,184,191,167,167,120,155