'$DYNAMIC
'current library-lotsvoic.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 getsprite (pic(), BYVAL x, BYVAL y, BYVAL w, BYVAL h, BYVAL p)
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 setkeys ()
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(), tmp(), BYVAL p)
DECLARE FUNCTION resetdsp ()
DECLARE SUB playsnd (BYVAL n, BYVAL f)
DECLARE SUB closefile ()
DECLARE SUB setwait (tmr(), BYVAL t)
DECLARE SUB dowait ()
DECLARE FUNCTION Keyseg ()
DECLARE FUNCTION keyoff ()
DECLARE FUNCTION keyval (BYVAL a)
DECLARE FUNCTION getkey ()
TYPE Regtype
 ax AS INTEGER
 bx AS INTEGER
 cx AS INTEGER
 dx AS INTEGER
 bp AS INTEGER
 si AS INTEGER
 di AS INTEGER
 flags AS INTEGER
 ds AS INTEGER
 es AS INTEGER
END TYPE
DIM SHARED regs AS Regtype

regs.ax = &H3509: CALL interruptx(&H21, regs, regs)
off9 = regs.bx: seg9 = regs.es
regs.ax = &H2509: regs.ds = Keyseg: regs.dx = keyoff
CALL interruptx(&H21, regs, regs)
1  RANDOMIZE TIMER
   setmodex
   DIM map(-1 TO 22, -1 TO 14), pic(138), bobpal(300), newpal(767), baspal(8), nme$(6), fadepal(1536), tmp(17000), voic(17000), txt(1024), mess$(31, 1), pict(15), pal(15), scln$(3), btype$(8)
   DIM ppic(30), pex(30), pded(30), ap(30), bp(30)
   'setitup "bobvoice.dat" + CHR$(0), voic(), tmp(), 2
   'voices = resetdsp
   setdiskpages tmp(), 200, 0
   FOR i = -1 TO 22: FOR j = -1 TO 14: map(i, j) = 14: NEXT j: NEXT i
   FOR i = 0 TO 3: READ scln$(i): NEXT i
   FOR i = 0 TO 7: READ btype$(i): NEXT i
   FOR i = 0 TO 15:  READ mess$(i, 0): NEXT i
   FOR i = 0 TO 15: READ pict(i): NEXT i
   FOR i = 0 TO 15: READ pal(i): NEXT i
   vlad = 0: hat = 0: bobpic = 0: invis = 0: ld = 1: lang = 0: dvc = 1: lvlb = 1
   DEF SEG = VARSEG(baspal(0))
   FOR i = 0 TO 15: POKE VARPTR(baspal(0)) + i, i: NEXT i
   setpal newpal()
   DEF SEG = VARSEG(newpal(0))
   BLOAD "palette.sto", VARPTR(newpal(0))
   DEF SEG = VARSEG(txt(0))
   BLOAD "bobtext.fnt", VARPTR(txt(0))
   setfont txt()
   loadpage "bobgraph.scr" + CHR$(0), 0, 3
   DEF SEG = VARSEG(bobpal(0)): BLOAD "bobgraph.pal", VARPTR(bobpal(0))
   DIM ded(138), car(138), cabag(138), spm(138), sun(138), dirt(138), con(138), digup(138), dug(138), web(138), tore(138)
   GOSUB 1915
   setvispage 0
   FOR i = 1 TO 11
   textcolor 32 - i, 0
   READ txt$: printstr txt$, 160 - LEN(txt$) * 4, i * 11 + 20, 0
   NEXT i
   fadetopal newpal(), fadepal()
   setkeys
   DO
   setkeys
   LOOP UNTIL keyval(0) > 0
   lvl = 1: speed# = .06: pointer = 0
   loadsprite pic(), vlad, 131, 16, 17, 3
   drawsprite pic(), baspal(), 0, 0, 183, 3
221 OPEN "LEVELS.DAT" FOR RANDOM ACCESS READ WRITE AS #1 LEN = 128
    FIELD #1, 120 AS ld$, 1 AS t1$, 1 AS t2$, 1 AS t3$, 1 AS tim$, 1 AS t5$, 1 AS t6$
223 x = 1: y = 1: ptyp = 0
    GOSUB 1600
225 clearpage 2: cpage = 1: dpage = 0
    GOSUB 1800
    GOSUB 1930
    copypage 2, cpage
    setvispage cpage
    fadetopal newpal(), fadepal()
    loadsprite pic(), vlad, 4, 16, 17, 3: smy = 1
    setkeys
570 copypage 2, dpage: t# = TIMER + speed#: setkeys
    IF keyval(1) > 1 THEN GOTO 1100
    IF keyval(74) > 1 THEN IF speed# < .1 THEN speed# = speed# + .01
    IF keyval(78) > 1 THEN IF speed# > .01 THEN speed# = speed# - .01
    IF keyval(25) > 1 THEN GOSUB 1920
 IF ptyp = 0 THEN
    IF keyval(72) > 1 AND y > 1 THEN y = y - 1
    IF keyval(75) > 1 AND x > 1 THEN x = x - 1
    IF keyval(77) > 1 AND x < 20 THEN x = x + 1
    IF keyval(80) > 1 AND y < 12 THEN y = y + 1
    IF keyval(52) > 1 THEN IF ptr < 15 THEN ptr = ptr + 1 ELSE ptr = 0
    IF keyval(51) > 1 THEN IF ptr > 0 THEN ptr = ptr - 1 ELSE ptr = 15
    IF keyval(31) > 1 THEN IF spmx = x AND spmy = y THEN spmx = 0 ELSE spmx = x: spmy = y
    IF keyval(28) > 1 THEN ptyp = ptyp XOR 1
    IF keyval(57) < 2 THEN GOTO 700
    map(x, y) = ptr
    tx = (x - 1) * 16: ty = (y - 1) * 16 + 7
    SELECT CASE ptr
    CASE 0, 2, 6 TO 13, 15
     drawsprite dug(), bobpal(), 224 + vladp, tx, ty, 2
    CASE 1, 3 TO 5
     getsprite pic(), 0, 184, 16, 16, 3
     drawsprite pic(), bobpal(), 224 + vladp, tx, ty + 1, 2
     IF lflg AND 1 THEN drawsprite con(), bobpal(), 224 + vladp, tx, ty, 2
    END SELECT
    SELECT CASE ptr
    CASE 3 TO 5, 11 TO 14
     loadsprite pic(), vlad, pict(ptr), 16, 17, 3
     drawsprite pic(), bobpal(), vladp + pal(ptr), tx, ty, 2
    CASE 2
     IF b > 0 THEN map(a / 16 + 1, (b - 7) / 16 + 1) = 0
    CASE 7
     IF rs > 0 THEN map(ar / 16 + 1, (br - 7) / 16 + 1) = 0
    CASE 9
     IF sh > 0 THEN map(ash / 16 + 1, (bsh - 7) / 16 + 1) = 0
    CASE 10
     IF bw > 0 THEN map(awb / 16 + 1, (bwb - 7) / 16 + 1) = 0
    CASE 15
     IF lg > 0 THEN map(lga / 16 + 1, (lgb - 7) / 16 + 1) = 0
    END SELECT
    GOSUB 1930
700 loadsprite pic(), vlad, pict(ptr), 16, 17, 3
    drawsprite pic(), bobpal(), vladp + pal(ptr), (x - 1) * 16, (y - 1) * 16 + 7, dpage
 ELSE
    IF keyval(75) > 1 THEN IF ptr > 0 THEN ptr = ptr - 1 ELSE ptr = 15
    IF keyval(77) > 1 THEN IF ptr < 15 THEN ptr = ptr + 1 ELSE ptr = 0
    IF keyval(28) > 1 OR keyval(57) > 1 THEN ptyp = ptyp XOR 1
    FOR i = 0 TO 15
     loadsprite pic(), vlad, pict(i), 16, 17, 3
     drawsprite pic(), bobpal(), vladp + pal(i), 32 + i * 16, 80, dpage
    NEXT i
 END IF
750 IF b = 0 THEN GOTO 820
    hp = hp XOR 1
    loadsprite pic(), vlad, 4 + hp, 16, 17, 3
    drawsprite pic(), bobpal(), vladp, a, b, dpage
820 FOR i = 1 TO pl
    IF pex(i) = 0 THEN GOTO 910
    ppic(i) = ppic(i) XOR 1
    IF pded(i) = 1 THEN IF ppic(i) < 8 THEN ppic(i) = 8 ELSE pex(i) = 0
    loadsprite pic(), vlad, 20 + ppic(i), 16, 17, 3
    drawsprite pic(), bobpal(), 16 + vladp, ap(i), bp(i), dpage
910 NEXT i
    IF sh = 0 THEN GOTO 970
    shp = shp XOR 1
    IF shded = 1 THEN IF shp < 8 THEN shp = 8 ELSE sh = 0: shp = 0
    loadsprite pic(), vlad, 52 + shp, 16, 17, 3
    drawsprite pic(), bobpal(), 48 + vladp, ash, bsh, dpage
970 FOR i = 1 TO cb
    IF cex(i) = 0 THEN GOTO 980
    cbp(i) = cbp(i) XOR 1
    IF cded(i) = 1 THEN IF cbp(i) < 8 THEN cbp(i) = 8 ELSE cbp(i) = 0: cex(i) = 0
    loadsprite pic(), vlad, 36 + cbp(i), 16, 17, 3
    drawsprite pic(), bobpal(), 32 + vladp, abug(i), bbug(i), dpage
980 NEXT i
981 IF rs = 0 THEN GOTO 990
    rp = rp XOR 1
    IF rded = 1 THEN IF rp < 8 THEN rp = 8 ELSE rs = 0
    loadsprite pic(), vlad, 68 + rp, 16, 17, 3
    drawsprite pic(), bobpal(), 64 + vladp, ar, br, dpage
990 IF bw = 0 THEN GOTO 995
    wbp = wbp XOR 1
    IF wbded = 1 THEN IF wbp < 8 THEN wbp = 8 ELSE bw = 0
    loadsprite pic(), vlad, 84 + hp, 16, 17, 3
    drawsprite pic(), bobpal(), 80 + vladp, awb, bwb, dpage
995 IF lg = 0 THEN GOTO 1000
    lgp = lgp XOR 1
    IF lded = 1 THEN IF lgp < 8 THEN lgp = 8 ELSE lg = 0
    loadsprite pic(), vlad, 100 + lgp, 16, 17, 3
    drawsprite pic(), bobpal(), 96 + vladp, lga, lgb, dpage
1000 IF spmx > 0 THEN drawsprite spm(), bobpal(), 192 + vladp, spmx * 16 - 16, spmy * 16 - 9, dpage
     textcolor 15, 0: printstr STR$(lvl), 152, 0, dpage
     printstr STR$(ct), 64, 0, dpage
     printstr mess$(ptr, lang), 200, 0, dpage
     IF hat > 0 THEN drawsprite spm(), bobpal(), 176 + vladp, a, b - 12, dpage
     IF pnt = 5 THEN pnt = 0 ELSE pnt = pnt + 1
     textcolor 88 + pnt, 0
     IF ptyp = 0 THEN printstr "|", (x - 1) * 16 + 5, (y - 1) * 16 + 3, dpage ELSE printstr "|", 36 + ptr * 16, 72, dpage
     setvispage dpage: SWAP cpage, dpage
     WHILE t# > TIMER: WEND: GOTO 570
1010 fadeto fadepal(), 0, 0, 0
     lvl = lvl + 1
     GOTO 223
1100 'settings
     ptr = 0
     leave = 0
     setkeys
     WHILE leave = 0
     setkeys
     copypage 2, dpage
     textcolor 11, 0
     printstr "Level-", 80, 20, dpage
     printstr "Extra Life-", 40, 35, dpage
     printstr "Thick Dirt-", 40, 50, dpage
     printstr "Angry Shrew-", 32, 65, dpage
     printstr "Hero Select-", 32, 80, dpage
     printstr "Bonus Level-", 32, 95, dpage
     textcolor 14, 0
     printstr "Undo Last Changes", 56, 155, dpage
     printstr "Save Current Level", 52, 170, dpage
     printstr "Quit Editor", 88, 185, dpage
     textcolor 10, 0
     printstr STR$(lvl), 128, 20, dpage
     IF spmx > 0 THEN printstr STR$(spmx) + "," + STR$(spmy), 128, 35, dpage ELSE printstr "No", 128, 35, dpage
     IF lflg AND 1 THEN printstr "Yes", 128, 50, dpage ELSE printstr "No", 128, 50, dpage
     IF lflg AND 2 THEN printstr "Vlad", 128, 80, dpage ELSE printstr "Bob", 128, 80, dpage
     IF lflg AND 8 THEN printstr "Yes", 128, 65, dpage ELSE printstr "No", 128, 65, dpage
     IF lflg AND 4 THEN
      textcolor 11, 0
      printstr "Bonus Time-", 40, 110, dpage
      printstr "Goal Type-", 48, 125, dpage
      printstr "Goal Num-", 56, 140, dpage
      textcolor 10, 0
      printstr "Yes", 128, 95, dpage
      printstr STR$(ltm), 128, 110, dpage
      printstr btype$(btyp), 128, 125, dpage
      printstr STR$(bgol), 128, 140, dpage
      IF keyval(72) > 1 THEN ptr = ptr - 1: IF ptr < 0 THEN ptr = 11
      IF keyval(80) > 1 THEN ptr = ptr + 1: IF ptr > 11 THEN ptr = 0
     ELSE
      IF keyval(72) > 1 THEN ptr = ptr - 1: IF ptr < 0 THEN ptr = 11 ELSE IF ptr > 5 AND ptr < 9 THEN ptr = 5
      IF keyval(80) > 1 THEN ptr = ptr + 1: IF ptr > 11 THEN ptr = 0 ELSE IF ptr > 5 AND ptr < 9 THEN ptr = 9
      printstr "No", 128, 95, dpage
     END IF
     textcolor 14, 0: printstr "|", 130, ptr * 15 + 12, dpage
     SELECT CASE ptr
     CASE 0
      IF keyval(75) > 1 THEN IF lvl > 1 THEN GOSUB 1700: lvl = lvl - 1: GOSUB 1600: GOSUB 1800
      IF keyval(77) > 1 THEN IF lvl < 50 THEN GOSUB 1700: lvl = lvl + 1: GOSUB 1600: GOSUB 1800
     CASE 2
      IF keyval(75) > 1 OR keyval(77) > 1 OR keyval(57) > 1 THEN lflg = lflg XOR 1: GOSUB 1800
     CASE 3
      IF keyval(75) > 1 OR keyval(77) > 1 OR keyval(57) > 1 THEN lflg = lflg XOR 8
     CASE 4
      IF keyval(75) > 1 OR keyval(77) > 1 OR keyval(57) > 1 THEN lflg = lflg XOR 2: GOSUB 1915: GOSUB 1800
     CASE 5
      IF keyval(75) > 1 OR keyval(77) > 1 OR keyval(57) > 1 THEN lflg = lflg XOR 4
     CASE 6
      IF keyval(75) > 1 AND (lflg AND 4) AND ltm > 0 THEN ltm = ltm - 1
      IF keyval(77) > 1 AND (lflg AND 4) AND ltm < 255 THEN ltm = ltm + 1
     CASE 7
      IF keyval(75) > 1 AND (lflg AND 4) AND btyp > 0 THEN btyp = btyp - 1
      IF keyval(77) > 1 AND (lflg AND 4) AND btyp < 7 THEN btyp = btyp + 1
      IF keyval(57) > 1 THEN btyp = btyp + 1: IF btyp > 7 THEN btyp = 0
     CASE 8
      IF keyval(75) > 1 AND (lflg AND 4) AND bgol > 0 THEN bgol = bgol - 1
      IF keyval(77) > 1 AND (lflg AND 4) AND bgol < 255 THEN bgol = bgol + 1
     CASE 9
      IF keyval(57) > 1 OR keyval(28) > 1 THEN GOSUB 1600
     CASE 10
      IF keyval(57) > 1 OR keyval(28) > 1 THEN GOSUB 1700
     CASE 11
      IF keyval(57) > 1 OR keyval(28) > 1 THEN leave = 2
     END SELECT
     IF keyval(1) > 1 THEN leave = 1
     SWAP cpage, dpage
     setvispage cpage
     WEND
     GOSUB 1700
     IF leave = 2 THEN fadeto fadepal(), 0, 0, 0: GOTO 1999 ELSE GOTO 223
1600 'load level
     GET #1, lvl: spmx = ASC(t1$): spmy = ASC(t2$): lflg = ASC(t3$): ltm = ASC(tim$): btyp = ASC(t5$): bgol = ASC(t6$)
     IF btyp > 7 OR btyp < 0 THEN btyp = 0
     IF spmx > 20 THEN spmx = 20: IF spmy > 12 THEN smpy = 12
     FOR j = 1 TO 12: FOR i = 1 TO 10
     map(i * 2 - 1, j) = ASC(MID$(ld$, i + (j - 1) * 10, 1)) AND 15: map(i * 2, j) = (ASC(MID$(ld$, i + (j - 1) * 10, 1)) AND 240) / 16
     NEXT i: NEXT j
     GOSUB 1915
     RETURN
1700 'save level
     tld$ = ""
     FOR j = 1 TO 12: FOR i = 1 TO 10
     tld$ = tld$ + CHR$(map(i * 2 - 1, j) + map(i * 2, j) * 16)
     NEXT i: NEXT j
     LSET ld$ = tld$
     LSET t1$ = CHR$(spmx): LSET t2$ = CHR$(spmy)
     LSET t3$ = CHR$(lflg): LSET tim$ = CHR$(ltm)
     LSET t5$ = CHR$(btyp): LSET t6$ = CHR$(bgol)
     PUT #1, lvl
     RETURN
1800 'draw level
     clearpage 2
     FOR i = 12 TO 1 STEP -1: FOR j = 20 TO 1 STEP -1
     k = (j - 1) * 16: l = (i - 1) * 16 + 7: m = map(j, i)
     drawsprite dirt(), bobpal(), 224 + vladp, k, l, 2
     IF (lflg AND 1) AND m = 1 THEN drawsprite con(), bobpal(), 224 + vladp, k, l, 2
     IF m = 0 OR m = 2 OR m > 5 THEN drawsprite dug(), bobpal(), 224 + vladp, k, l, 2
     IF m = 3 THEN drawsprite car(), bobpal(), 160 + vladp, k, l, 2
     IF m = 4 OR m = 13 THEN drawsprite cabag(), bobpal(), 144 + vladp, k, l, 2
     IF m = 5 THEN drawsprite sun(), bobpal(), 176 + vladp, k, l, 2
     IF m = 11 THEN drawsprite web(), bobpal(), 208 + vladp, k, l, 2
     IF m = 12 THEN drawsprite ded(), bobpal(), 128 + vladp, k, l, 2
     IF m = 14 THEN drawsprite con(), bobpal(), 224 + vladp, k, l, 2
     NEXT j: NEXT i
     textcolor 15, 0
     printstr scln$(lang + vlad / 80), 0, 0, 2
     RETURN
1900 'delay of 1 second
     t = TIMER + 1: WHILE t > TIMER: WEND
     RETURN
1915 IF (lflg AND 2) = 0 THEN vlad = 0: vladp = 0 ELSE vlad = 160: vladp = 240
     loadsprite ded(), vlad, 124, 16, 17, 3
     loadsprite cabag(), vlad, 125, 16, 17, 3
     loadsprite car(), vlad, 126, 16, 17, 3
     loadsprite sun(), vlad, 127, 16, 17, 3
     loadsprite spm(), vlad, 128, 16, 17, 3
     loadsprite web(), vlad, 129, 16, 17, 3
     loadsprite tore(), vlad, 130, 16, 17, 3
     loadsprite dirt(), vlad, 131, 16, 17, 3
     loadsprite digup(), vlad, 132, 16, 17, 3
     loadsprite dug(), vlad, 133, 16, 17, 3
     loadsprite con(), vlad, 134, 16, 17, 3
     RETURN
1920 'pause
     fadeto fadepal(), INT(RND(1) * 64), INT(RND(1) * 64), INT(RND(1) * 64)
     lk = getkey
     fadetopal newpal(), fadepal()
     RETURN
1930 'setstuff
     FOR i = 1 TO pl: pex(i) = 0: pded(i) = 1: NEXT i
     FOR i = 1 TO cb: cex(i) = 0: cded(i) = 1: NEXT i
     rded = 1: shded = 1: wbded = 1: lded = 1
     b = 0
     ct = 0
     pl = 0
     cb = 0
     FOR i = 1 TO 12: FOR j = 1 TO 20
     ta = (j - 1) * 16: tb = (i - 1) * 16 + 7
     IF map(j, i) = 2 THEN a = ta: b = tb
     IF map(j, i) = 3 THEN ct = ct + 1
     IF map(j, i) = 6 THEN IF pl < 30 THEN pl = pl + 1: ppic(pl) = 0: pex(pl) = 1: pded(pl) = 0: ap(pl) = ta: bp(pl) = tb ELSE map(i, j) = 0
     IF map(j, i) = 7 THEN rded = 0: rp = 0: ar = ta: br = tb: rs = 1
     IF map(j, i) = 8 THEN cb = cb + 1: cbp(cb) = 0: cex(cb) = 1: cded(cb) = 0: abug(cb) = ta: bbug(cb) = tb
     IF map(j, i) = 9 THEN shded = 0: shp = 0: ash = ta: bsh = tb: sh = 1
     IF map(j, i) = 10 THEN wbded = 0: wbp = 0: awb = ta: bwb = tb: bw = 1
     IF map(j, i) = 15 THEN lded = 0: lgp = 0: lga = ta: lgb = tb: lg = 1
     NEXT j: NEXT i
     RETURN
     'top lines
     DATA "Carrots:     Level:"
     DATA " ’­Œ‚  :      ÊÔ~É:"
     DATA "  Coins:     Stage:"
     DATA "     …œ:     ¿Å´¾~:"
     'bonus level types
     DATA "Eat Carrots/Get Money","Kill Plips/Walruses","Kill Beetles/Worms","Kill Sharks/Pavenders","Shoot Shrews/Turks","Get Turks/Shrews Killed","Save Turks/Shrews","Kill Lagomorph/Soldier"
     'item types
     DATA "Space","Dirt","Bob","Carrot","Cabbage","Sunseed","Plip","Shrew","Beetle","Shark","Spider","Web","Bones","Magic Cabbage","Rocks","Rabbit"
     'pictures
     DATA 133,131,4,126,125,127,20,68,36,52,84,129,124,125,134,100
     DATA 224,224,0,160,144,176,16,64,32,48,80,208,128,144,224,96
     'How to
     DATA "Bob the Hamster Level Editor"
     DATA "Press Enter to Bring up the object menu"
     DATA "Press space to place an object/enemy"
     DATA "Press Escape to bring up the level menu"
     DATA "Press left and right to change options"
     DATA "and escape or enter to leave the menus"
     DATA "Levels are automatically saved when you"
     DATA "Change levels or quit"
     DATA "To play your levels set the level type"
     DATA "to ~custom~ from the Bob the Hamster"
     DATA "Options menu."
1999 regs.ax = &H2509: regs.ds = seg9: regs.dx = off9
     CALL interruptx(&H21, regs, regs)
     'closefile
     SCREEN 13: SCREEN 0: CLS : WIDTH 80: SYSTEM: 'quit routine