'$DYNAMIC
'current library-allmodex.qlb
DEFINT A-Z
DECLARE SUB setmodex ()
DECLARE SUB copypage (BYVAL page1, BYVAL page2)
DECLARE SUB setvispage (BYVAL page)
DECLARE SUB fadeto (palbuff(), BYVAL red, BYVAL green, BYVAL blue)
DECLARE SUB fadetopal (pal(), palbuff())
DECLARE SUB setpal (pal())
DECLARE SUB clearpage (BYVAL page)
DECLARE SUB setdiskpages (buf(), BYVAL h, BYVAL l)
DECLARE SUB loadpage (fil$, BYVAL i, BYVAL p)
DECLARE SUB storepage (fil$, BYVAL i, BYVAL p)
DECLARE SUB drawpage (map(), BYVAL l, BYVAL p)
DECLARE SUB putpixel (BYVAL x, BYVAL y, BYVAL c, BYVAL p)
DECLARE SUB rectangle (BYVAL x, BYVAL y, BYVAL w, BYVAL h, BYVAL c, BYVAL p)
DECLARE FUNCTION readpixel (BYVAL x, BYVAL y, BYVAL p)
DIM master(767), fadepal(1584), map(320), tmp(8000), cutnpaste(19, 19)

mapfile$ = "bob.all" + CHR$(0)
pagenum = 1

setmodex
setpal master(): DEF SEG = VARSEG(master(0)): BLOAD "master.pal", VARPTR(master(0))
setpal master()
setdiskpages tmp(), 200, 0
loadpage mapfile$, pagenum, 3
FOR i = 0 TO 31
FOR j = 0 TO 7
rectangle i * 10, j * 5 + 160, 10, 5, j * 32 + i, 2
NEXT j: NEXT i
vpage = 0: dpage = 1
bnum = 0: c = 17

'pick block to draw
pickit:
copypage 3, dpage
a$ = INKEY$
IF a$ = CHR$(27) THEN GOTO done
IF a$ = CHR$(0) + CHR$(75) THEN IF bnum > 0 THEN bnum = bnum - 1
IF a$ = CHR$(0) + CHR$(77) THEN IF bnum < 159 THEN bnum = bnum + 1
IF a$ = CHR$(0) + CHR$(72) THEN IF bnum > 15 THEN bnum = bnum - 16
IF a$ = CHR$(0) + CHR$(80) THEN IF bnum < 144 THEN bnum = bnum + 16
IF a$ = "c" THEN GOSUB copy
IF a$ = "p" THEN GOSUB paste
bx = bnum AND 15
by = INT(bnum / 16)
IF a$ = CHR$(32) OR a$ = CHR$(13) THEN GOTO drawit
IF c < 30 THEN c = c + 1 ELSE c = 17
rectangle bx * 20 + 7, by * 20 + 7, 6, 6, c, dpage
SWAP dpage, vpage
setvispage vpage
GOTO pickit

'draw large block
drawit:
rectangle 59, 0, 202, 161, 15, 2
FOR i = 0 TO 19
FOR j = 0 TO 19
rectangle 60 + i * 10, j * 8, 10, 8, readpixel(bx * 20 + i, by * 20 + j, 3), 2
NEXT j
NEXT i

'edit block
edit:
copypage 2, dpage
a$ = INKEY$
IF a$ = CHR$(27) THEN GOTO pickit
IF a$ = CHR$(0) + CHR$(75) THEN IF x > 0 THEN x = x - 1
IF a$ = CHR$(0) + CHR$(77) THEN IF x < 19 THEN x = x + 1
IF a$ = CHR$(0) + CHR$(72) THEN IF y > 0 THEN y = y - 1
IF a$ = CHR$(0) + CHR$(80) THEN IF y < 19 THEN y = y + 1
IF a$ = "r" THEN rx = 1: ry = 1: GOTO rect
IF a$ = "," THEN IF cc > 0 THEN cc = cc - 1
IF a$ = "." THEN IF cc < 255 THEN cc = cc + 1
IF a$ = "'" THEN IF cc > 31 THEN cc = cc - 32
IF a$ = "/" THEN IF cc < 224 THEN cc = cc + 32
IF a$ = CHR$(32) THEN putpixel bx * 20 + x, by * 20 + y, cc, 3: rectangle 60 + x * 10, y * 8, 10, 8, cc, 2
IF a$ = CHR$(13) THEN cc = readpixel(bx * 20 + x, by * 20 + y, 3)
cy = INT(cc / 32)
cx = cc AND 31
IF c < 61 THEN c = c + 2 ELSE c = 17
rectangle cx * 10 + 4, cy * 5 + 162, 3, 1, c, dpage
rectangle 60 + x * 10, y * 8, 10, 8, readpixel(bx * 20 + x, by * 20 + y, 3), dpage
rectangle x * 10 + 64, y * 8 + 3, 3, 2, c, dpage
SWAP dpage, vpage
setvispage vpage
GOTO edit

rect:
copypage 2, dpage
a$ = INKEY$
IF a$ = CHR$(27) THEN GOTO edit
IF a$ = CHR$(0) + CHR$(75) THEN IF rx > 1 THEN rx = rx - 1
IF a$ = CHR$(0) + CHR$(77) THEN IF x + rx < 20 THEN rx = rx + 1
IF a$ = CHR$(0) + CHR$(72) THEN IF ry > 1 THEN ry = ry - 1
IF a$ = CHR$(0) + CHR$(80) THEN IF y + ry < 20 THEN ry = ry + 1
IF a$ = "," THEN IF cc > 0 THEN cc = cc - 1
IF a$ = "." THEN IF cc < 255 THEN cc = cc + 1
IF a$ = "'" THEN IF cc > 31 THEN cc = cc - 32
IF a$ = "/" THEN IF cc < 224 THEN cc = cc + 32
IF a$ = CHR$(13) OR a$ = CHR$(32) THEN rectangle bx * 20 + x, by * 20 + y, rx, ry, cc, 3: rectangle 60 + x * 10, y * 8, rx * 10, ry * 8, cc, 2: GOTO edit
cy = INT(cc / 32)
cx = cc AND 31
IF c < 61 THEN c = c + 2 ELSE c = 17
rectangle cx * 10 + 4, cy * 5 + 162, 3, 1, c, dpage
rectangle x * 10 + 59, y * 8, 10 * rx + 2, 8 * ry + 1, c, dpage
rectangle 60 + x * 10, y * 8, 10 * rx, 8 * ry, cc, dpage
SWAP dpage, vpage
setvispage vpage
GOTO rect

copy:
FOR i = 0 TO 19
FOR j = 0 TO 19
cutnpaste(i, j) = readpixel(bx * 20 + i, by * 20 + j, 3)
NEXT j: NEXT i
RETURN

paste:
FOR i = 0 TO 19
FOR j = 0 TO 19
putpixel bx * 20 + i, by * 20 + j, cutnpaste(i, j), 3
NEXT j: NEXT i
RETURN

done:
storepage mapfile$, pagenum, 3
SYSTEM