'$DYNAMIC
'current lib-timing.qlb
DEFINT A-Z
DECLARE SUB setmodex ()
DECLARE SUB copypage (BYVAL page1, BYVAL page2)
DECLARE SUB setvispage (BYVAL page)
DECLARE SUB drawsprite (pic(), pal(), BYVAL po, BYVAL x, BYVAL y, BYVAL page)
DECLARE SUB loadsprite (pic(), BYVAL x, BYVAL y, BYVAL w, BYVAL h, 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 setfont (f())
DECLARE SUB printstr (s$, BYVAL x, BYVAL y, BYVAL p)
DECLARE SUB textcolor (BYVAL f, BYVAL b)
DECLARE SUB setitup (fil$, buff(), BYVAL p)
DECLARE SUB resetdsp
DECLARE SUB playsnd (BYVAL n, BYVAL f)
DECLARE SUB closefile
DECLARE SUB setwait (a(), BYVAL t)
DIM t(1), pic(138), bobpal(300), newpal(767), fadepal(1536), tmp(8000), voic(32000), txt(1024), xloc(8), yloc(8), xmov(8), ymov(8), dist(8), pict(8), pal(8), vld(8), buf(32000), guide(10), guide$(10, 6), index&(4000)
DIM toonoff(15), toonptr(15), toonscr(15)
setmodex
setitup "bobvoice.dat" + CHR$(0), voic(), 2
resetdsp
DEF SEG = VARSEG(newpal(0))
BLOAD "palette.sto", VARPTR(newpal(0))
setpal newpal()
DEF SEG = VARSEG(txt(0))
BLOAD "bobtext.fnt", VARPTR(txt(0))
setfont txt()
setdiskpages tmp(), 200, 0
loadpage "bobgraph.scr" + CHR$(0), 0, 3
DEF SEG = VARSEG(bobpal(0)): BLOAD "bobgraph.pal", VARPTR(bobpal(0))
FOR i = 0 TO 6
READ guide(i)
FOR j = 0 TO guide(i)
READ guide$(i, j)
NEXT j: NEXT i
toons = 11
FOR i = 1 TO toons
READ toonoff(i), toonptr(i), toonscr(i)
NEXT i
track = 1
toon = 1

fm$ = "bobgraph.anm"

ticks = 110: vlad = 0
vpage = 0: dpage = 1
cntr = 1
clearpage 2
OPEN fm$ FOR BINARY AS #1
start = 1
menu:
num2 = 413
loadpage "bobgraph.scr" + CHR$(0), toonscr(toon), 2
copypage 2, vpage
textcolor 15, 0
printstr "(1) Edit pattern", 0, 0, vpage
printstr "(2) Run Pattern", 0, 8, vpage
printstr "(3) Switch Pattern", 0, 16, vpage
setvispage vpage
a$ = INPUT$(1)
IF a$ = "1" THEN GOTO showit
IF a$ = "2" THEN cntr = toonoff(toon): clik = 0: GOSUB clearpic: GOTO getloop
IF a$ = "3" THEN IF toon < toons THEN toon = toon + 1 ELSE toon = 1
IF a$ = CHR$(27) THEN GOTO endit
GOTO menu

showit:
GET #1, 1, tmp
cntr = 1
a = 1
WHILE EOF(1) = 0
GOSUB getit
buf(cntr - 2) = a
WEND

top = cntr - 2
ptr = 0
stuf = 0
WHILE ptr < top
index&(stuf) = ptr
IF buf(ptr) > 6 THEN buf(ptr) = 0
ptr = ptr + guide(buf(ptr)) + 1
stuf = stuf + 1
WEND
stuf = stuf - 1

ptr = toonptr(toon)
y = 0
textcolor 15, 0
editit:
IF track = 1 THEN copypage 2, dpage ELSE clearpage dpage
tmp = index&(ptr)
IF buf(tmp) > 6 THEN buf(tmp) = 0
IF y > guide(buf(tmp)) THEN y = guide(buf(tmp))
IF y = 0 THEN textcolor 14, 0 ELSE textcolor 15, 0
printstr STR$(tmp) + guide$(buf(tmp), 0), 8, 8, dpage
FOR i = 1 TO guide(buf(tmp))
IF i = y THEN textcolor 14, 0 ELSE textcolor 15, 0
printstr guide$(buf(tmp), i) + STR$(buf(tmp + i)), 8, 24 + i * 10, dpage
NEXT i
IF track = 1 THEN GOSUB trackit
printstr "cycle #-" + STR$(clik), 0, 116, dpage
SWAP vpage, dpage
setvispage vpage
a$ = ""
WHILE a$ = "": a$ = INKEY$: WEND
IF a$ = CHR$(0) + CHR$(75) AND ptr > 0 THEN ptr = ptr - 1: IF buf(tmp) = 5 THEN clik = clik - buf(tmp + 1)
IF a$ = CHR$(0) + CHR$(77) AND ptr < stuf THEN ptr = ptr + 1: IF buf(index&(ptr)) = 5 THEN clik = clik + buf(index&(ptr) + 1)
IF a$ = CHR$(0) + CHR$(72) AND y > 0 THEN y = y - 1
IF a$ = CHR$(0) + CHR$(80) AND y < guide(buf(tmp)) THEN y = y + 1
IF a$ = "t" THEN track = track XOR 1
IF a$ = "p" AND buf(tmp) = 6 THEN playsnd buf(tmp + 1) AND 255, buf(tmp + 2) AND 255
IF a$ = "+" THEN GOTO insert
IF a$ = "-" THEN GOTO delete
IF a$ = " " THEN GOTO change
IF a$ = CHR$(27) THEN GOTO saveit
GOTO editit
saveit:
tmp = index&(stuf)
FOR i = 0 TO tmp + guide(buf(tmp))
PUT #1, i + 1, buf(i)
NEXT i
clearpage 2: GOTO menu

change:
a$ = ""
b$ = ""
textcolor 11, 240
WHILE a$ <> CHR$(13)
printstr "? " + b$ + "  ", 30, 100, vpage
a$ = INPUT$(1)
IF a$ <> CHR$(8) THEN b$ = b$ + a$
IF a$ = CHR$(8) AND LEN(b$) > 0 THEN b$ = LEFT$(b$, LEN(b$) - 1)
WEND
a = VAL(b$)
IF a < 0 THEN a = 0 ELSE IF a > 255 THEN a = 255
IF y = 0 THEN
 IF a > 6 THEN GOTO change
 IF ptr = stuf THEN stuf = stuf + 1: index&(stuf) = index&(ptr) + guide(buf(tmp)) + 1
 df = guide(buf(tmp)) - guide(a)
 GOSUB moveit
END IF
buf(tmp + y) = a
GOTO editit

insert:
FOR i = index&(stuf) + guide(buf(index&(stuf))) TO tmp STEP -1
buf(i + 1) = buf(i)
NEXT i
FOR i = stuf TO ptr STEP -1
index&(i + 1) = index&(i) + 1
NEXT i
buf(tmp) = 0
stuf = stuf + 1
GOTO editit

delete:
df = guide(buf(tmp)) + 1
GOSUB moveit
FOR i = ptr + 1 TO stuf
index&(i - 1) = index&(i)
NEXT i
stuf = stuf - 1
GOTO editit

moveit:
IF df > 0 THEN
 FOR i = tmp + guide(buf(tmp)) + 1 TO index&(stuf) + guide(buf(index&(stuf)))
 buf(i - df) = buf(i)
 NEXT i
END IF
IF df < 0 THEN
 FOR i = index&(stuf) + guide(buf(index&(stuf))) TO tmp + guide(buf(tmp)) + 1 STEP -1
 buf(i - df) = buf(i)
 NEXT i
END IF
FOR i = ptr + 1 TO stuf
index&(i) = index&(i) - df
NEXT i
RETURN

clearpic:
FOR i = 0 TO 8
pict(i) = 0: dist(i) = 0
NEXT i
RETURN

getloop:
GOSUB getit
what = a
GOSUB getit
targ = a
SELECT CASE what
CASE 0
 GOTO menu
CASE 1
 GOSUB getit
 xloc(targ) = a * 2
 GOSUB getit
 yloc(targ) = a
 GOSUB getit
 pict(targ) = a
 GOSUB getit
 pal(targ) = (a AND 127) * 16
 vld(targ) = (a AND 128) / 128 * 160
CASE 2
 GOSUB getit
 pict(targ) = a
CASE 3
 GOSUB getit
 xloc(targ) = a * 2
 GOSUB getit
 yloc(targ) = a
CASE 4
 GOSUB getit
 xmov(targ) = a
 GOSUB getit
 ymov(targ) = a
 GOSUB getit
 IF (a AND 1) = 1 THEN xmov(targ) = -xmov(targ)
 IF (a AND 2) = 2 THEN ymov(targ) = -ymov(targ)
 IF (a AND 4) = 4 THEN switch(targ) = 0 ELSE switch(targ) = 1
 GOSUB getit
 dist(targ) = a
CASE 5
 cycles = targ
CASE 6
 GOSUB getit
 playsnd targ, a
END SELECT

doloop:
IF cycles = 0 THEN GOTO getloop
setwait t(), ticks
copypage 2, dpage
FOR i = 0 TO 8
IF pict(i) > 0 THEN
 loadsprite pic(), vld(i), pict(i), 16, 17, 3
 drawsprite pic(), bobpal(), pal(i), xloc(i), yloc(i), dpage
END IF
IF dist(i) > 0 THEN dist(i) = dist(i) - 1: xloc(i) = xloc(i) + xmov(i): yloc(i) = yloc(i) + ymov(i): IF switch(i) = 1 THEN pict(i) = pict(i) XOR 1
NEXT i
SWAP vpage, dpage
setvispage vpage
WHILE t(0) = 0: WEND
cycles = cycles - 1: GOTO doloop

trackit:
clik = 0
pont = toonptr(toon): cycles = 0: GOSUB clearpic
WHILE pont <= ptr
IF cycles = 1 THEN
 FOR i = 0 TO 8
  ty = yloc(i) + ymov(i)
  tx = xloc(i) + xmov(i)
  IF dist(i) > 0 THEN dist(i) = dist(i) - 1: xloc(i) = tx: yloc(i) = ty: IF switch(i) = 1 THEN pict(i) = pict(i) XOR 1
 NEXT i
 cycles = 0
END IF
tmp = index&(pont)
targ = buf(tmp + 1)
SELECT CASE buf(tmp)
CASE 0
 pont = ptr
CASE 1
 xloc(targ) = buf(tmp + 2) * 2
 yloc(targ) = buf(tmp + 3)
 pict(targ) = buf(tmp + 4)
 pal(targ) = (buf(tmp + 5) AND 127) * 16
 vld(targ) = (buf(tmp + 5) AND 128) / 128 * 160
CASE 2
 pict(targ) = buf(tmp + 2)
CASE 3
 xloc(targ) = buf(tmp + 2) * 2
 yloc(targ) = buf(tmp + 3)
CASE 4
 a = buf(tmp + 4)
 xmov(targ) = buf(tmp + 2)
 IF (a AND 1) = 1 THEN xmov(targ) = -xmov(targ)
 ymov(targ) = buf(tmp + 3)
 IF (a AND 2) = 2 THEN ymov(targ) = -ymov(targ)
 IF (a AND 4) = 4 THEN switch(targ) = 0 ELSE switch(targ) = 1
 dist(targ) = buf(tmp + 5)
CASE 5
 clik = clik + targ
 IF targ > 1 THEN
  FOR targ = targ TO 2 STEP -1
   FOR i = 0 TO 8
    ty = yloc(i) + ymov(i)
    tx = xloc(i) + xmov(i)
    IF dist(i) > 0 THEN dist(i) = dist(i) - 1: xloc(i) = tx: yloc(i) = ty: IF switch(i) = 1 THEN pict(i) = pict(i) XOR 1
   NEXT i
  NEXT targ
 END IF
 cycles = targ
END SELECT
pont = pont + 1
WEND
FOR i = 0 TO 8
IF pict(i) > 0 THEN
 loadsprite pic(), vld(i), pict(i), 16, 17, 3
 drawsprite pic(), bobpal(), pal(i), xloc(i), yloc(i), dpage
END IF
NEXT i
tmp = index&(ptr)
RETURN

endit:
CLOSE #1
closefile
SCREEN 7: SCREEN 0: WIDTH 80: CLS
SYSTEM

getit:
GET #1, cntr, a
cntr = cntr + 1
a = a AND 255
RETURN

readit:
GET #1, cntr, a
a = a AND 255
b$ = STR$(a)
RETURN

DATA 0,". End Pattern"
DATA 5,". Start Character","Number ","X location ","Y location ","Picture # ","Palette # "
DATA 2,". Change Picture","Number ","Picture # "
DATA 3,". Change Location","Number ","X location ","Y location "
DATA 5,". Set Motion","Number ","X motion ","Y motion ","Flags ","time to move "
DATA 1,". Move cycles","Cycles "
DATA 2,". Play Voice","Number ","Speed "

DATA 7256,1915,4,6660,1751,4,6334,1662,6,5488,1446,6,4014,1060,4,3420,908,5,2215,589,5,1745,457,1,1330,360,4,954,258,4,412,114,2,1,0,3