DECLARE SUB Drlin (x1!, y1!, x2!, y2!)
DECLARE SUB Drblock (x1!, y1!, x2!, y2!)

'set up the mouse drivers
DECLARE SUB vsMOUSE (action$, a1%, a2%, a3%, a4%)
DECLARE FUNCTION vsINTERR% (ax%, bx%, cx%, dx%)
DIM mouse1(0 TO 45) AS INTEGER
RESTORE DataForMouse
DEF SEG = VARSEG(mouse1(0))
FOR i% = 0 TO 52
  READ Byte$
  POKE VARPTR(mouse1(0)) + i%, VAL("&H" + Byte$)
NEXT
DataForMouse:
DATA 55,8b,ec,56,57,8b,76,0c,8b,04,8b,76,0a,8b,1c,8b,76,08,8b,0c,8b,76,06,8b
DATA 14,cd,21,8b,76,0c,89,04,8b,76,0a,89,1c,8b,76,08,89,0c,8b,76,06,89,14,5f
DATA 5e,5d,ca,08,00

'set up objects and colors
DIM ob(15), co(15), oc$(15)
RESTORE DataForObjects
FOR t = 1 TO 15
READ ob(t), co(t), oc$(t)
NEXT

DataForObjects:
DATA 219, 7,"l"
DATA 177, 9,"b"
DATA 115, 7,"s"
DATA 219, 7,"p"
DATA 176, 12,"w"
DATA 4, 15,"c"
DATA 244, 14,"k"
DATA 8,6,"d"
DATA 234, 4,"e"
DATA 21, 11,"v"
DATA 5,13,"Q"
DATA 16, 2,"a"
DATA 127, 13,"m"
DATA 233, 7,"n"
DATA 26, 10, "o"

'variables
cur = 1                 'current room
maxitems = 100
maxrooms = 30
DIM room$(30, 100)       'max of 25 rooms, 50 points per room
DIM items(30)           'number of items in a room
FOR t = 1 TO 30
items(t) = 0
NEXT t
DIM oldroom(80)

'here's how the buttons will be set up on the bottom of the screen:
'(and define constants)
WALL = 1        'Wall - 2,21 - 5,21
WALL2 = 1.5     'second point of a wall
BLCK = 2        'Block - 2,22 - 6,22
BLCK2 = 2.5
SPCE = 3        'Spaces - 2,23
PONT = 4        'Points - 5,23
WARP = 5        'warp tiles - 10,21
DIAM = 6        'diamonds - 10,22
KEYS = 7        'keys - 10,23
DOOR = 8        'doors - 20,21
ENEM = 9        'enemies - 20,22
CONT = 10       'cont.point - 20,23
OVER = 11       'end of game - 30,21
ARRO = 12       'arrows - 30,22
BOMB = 13       'bombs - 30,23
MINE = 14       'mines - 40,21
ORIG = 15       'origin - 40, 22

OPEN "edit.ini" FOR INPUT AS #1
INPUT #1, n$
CLOSE #1
GOSUB reload

start:
mode = WALL
GOSUB drawmenu
GOSUB showstatus
GOSUB drawroom

mnlp:
vsMOUSE "area", 0, 639, 0, 199
vsMOUSE "show", 0, 0, 0, 0
vsMOUSE "position", 319, 99, 0, 0

left = 0
right = 0
DO
  vsMOUSE "get", 0, 0, 0, 0
  x = INT(mouseX% / 640 * 80) + 1
  y = INT(mouseY% / 200 * 25) + 1

  IF y < 21 THEN GOSUB showcoords

  IF mouseb% = 1 THEN left = 1
  IF mouseb% = 2 THEN right = 1

  IF NOT ((mouseb% AND 1) = 0 AND left = 1) THEN GOTO noleft

  IF y = 21 AND x >= 2 AND x <= 6 THEN mode = WALL
  IF y = 22 AND x >= 2 AND x <= 7 THEN mode = BLCK
  IF y = 23 AND x = 2 THEN mode = SPCE
  IF y = 23 AND x = 5 THEN mode = PONT
  IF y = 21 AND x = 10 THEN mode = WARP
  IF y = 22 AND x = 10 THEN mode = DIAM
  IF y = 23 AND x = 10 THEN mode = KEYS
  IF y = 21 AND x = 20 THEN mode = DOOR
  IF y = 22 AND x = 20 THEN mode = ENEM
  IF y = 23 AND x = 20 THEN mode = CONT
  IF y = 21 AND x = 30 THEN mode = OVER
  IF y = 22 AND x = 30 THEN mode = ARRO
  IF y = 23 AND x = 30 THEN mode = BOMB
  IF y = 21 AND x = 40 THEN mode = MINE
  IF y = 22 AND x = 40 THEN mode = ORIG
  IF y = 22 AND (x = 60 OR x = 61) AND cur > 5 THEN cur = cur - 5: GOSUB UP: GOSUB drawroom
  IF y = 22 AND (x = 63 OR x = 64) AND cur < 26 THEN cur = cur + 5: GOSUB DN: GOSUB drawroom
  IF y = 22 AND (x = 66 OR x = 67) AND cur > 1 THEN cur = cur - 1: GOSUB LT: GOSUB drawroom
  IF y = 22 AND (x = 69 OR x = 70) AND cur < 30 THEN cur = cur + 1: GOSUB RT: GOSUB drawroom
  IF y < 21 AND mode <> WALL AND mode <> BLCK THEN
        GOSUB dosomething
  ELSEIF y < 21 AND mode = WALL THEN
        GOSUB startwall
        GOSUB showstatus
  ELSEIF y < 21 AND mode = BLCK THEN
        GOSUB startblock
        GOSUB showstatus
  ELSE
        GOSUB showstatus
  END IF

  IF y = 21 AND x >= 45 AND x <= 48 THEN GOSUB load
  IF y = 21 AND x >= 51 AND x <= 54 THEN GOSUB save
  IF y = 22 AND x >= 75 AND x <= 78 THEN
        GOSUB resave
        OPEN "game.ini" FOR OUTPUT AS #1
        PRINT #1, n$
        CLOSE #1
        CHAIN "game.exe"
  END IF
  IF y = 23 AND x >= 75 AND x <= 78 THEN
        GOSUB resave
        OPEN "editor.ini" FOR OUTPUT AS #1
        PRINT #1, n$
        CLOSE #1
        SYSTEM
  END IF
  IF y = 21 AND x >= 75 AND x <= 78 THEN
        FOR i = 1 TO maxrooms
                FOR j = 1 TO items(i)
                        room$(i, j) = ""
                NEXT j
                items(i) = 0
        NEXT i
        items(1) = 2
        room$(1, 1) = "o40"
        room$(1, 2) = "10"
        GOSUB new
        GOTO start
  END IF

  left = 0

noleft:

  IF (mouseb% AND 2) = 0 AND right = 1 AND mode = INT(mode) THEN GOSUB eraseobject: right = 0

  SELECT CASE INKEY$
  CASE CHR$(0) + "H"
        IF cur > 5 THEN cur = cur - 5: GOSUB UP: GOSUB drawroom: GOSUB showstatus
  CASE CHR$(0) + "P"
        IF cur < 26 THEN cur = cur + 5: GOSUB DN: GOSUB drawroom: GOSUB showstatus
  CASE CHR$(0) + "K"
        IF cur > 1 THEN cur = cur - 1: GOSUB LT: GOSUB drawroom: GOSUB showstatus
  CASE CHR$(0) + "M"
        IF cur < 30 THEN cur = cur + 1: GOSUB RT: GOSUB drawroom: GOSUB showstatus
  CASE CHR$(27)
        SYSTEM
  END SELECT

LOOP

showstatus:
COLOR 15
LOCATE 23, 45
SELECT CASE mode
        CASE WALL
        PRINT "Walls-----";
        CASE WALL2
        PRINT "2nd Point-";
        CASE BLCK
        PRINT "Blocks----";
        CASE BLCK2
        PRINT "2nd Point-";
        CASE SPCE
        PRINT "Spaces----";
        CASE PONT
        PRINT "Points----";
        CASE WARP
        PRINT "Warp Tiles";
        CASE DIAM
        PRINT "Diamonds--";
        CASE KEYS
        PRINT "Keys------";
        CASE DOOR
        PRINT "Doors-----";
        CASE ENEM
        PRINT "Enemies---";
        CASE CONT
        PRINT "Cont.Point";
        CASE OVER
        PRINT "End-O-Game";
        CASE ARRO
        PRINT "Arrows----";
        CASE BOMB
        PRINT "Bombs-----";
        CASE MINE
        PRINT "Mines-----";
        CASE ORIG
        PRINT "Origin----";
END SELECT
COLOR co(mode)
PRINT CHR$(ob(mode))
COLOR 15
LOCATE 23, 66
PRINT "     "
LOCATE 23, 60
PRINT "Room:  "; cur
LOCATE 22, 52
PRINT "    "
IF items(cur) = maxitems THEN COLOR 4
LOCATE 22, 45
PRINT "Items: "; items(cur) / 2
COLOR 7
RETURN

showcoords:
COLOR 15
LOCATE 21, 60
IF x < 10 THEN
        PRINT "  ";
ELSE
        PRINT " ";
END IF
PRINT STR$(x); " ,"
LOCATE 21, 66
IF y < 10 THEN PRINT " ";
PRINT STR$(y); "  "
RETURN

dosomething:

SELECT CASE mode
        CASE WALL2
        IF items(cur) = maxitems - 2 THEN PLAY "l64o0ac": RETURN
        y2 = y
        x2 = x
        CALL Drlin(x1, y1, x2, y2)
        mode = WALL
        room$(cur, items(cur) + 1) = oc$(mode) + STR$(x1)
        room$(cur, items(cur) + 2) = STR$(y1)
        room$(cur, items(cur) + 3) = STR$(x2)
        room$(cur, items(cur) + 4) = STR$(y2)
        items(cur) = items(cur) + 4
        GOSUB showstatus
        CASE BLCK2
        IF items(cur) = maxitems - 2 THEN PLAY "l64o0ac": RETURN
        y2 = y
        x2 = x
        CALL Drblock(x1, y1, x2, y2)
        mode = BLCK
        room$(cur, items(cur) + 1) = oc$(mode) + STR$(x1)
        room$(cur, items(cur) + 2) = STR$(y1)
        room$(cur, items(cur) + 3) = STR$(x2)
        room$(cur, items(cur) + 4) = STR$(y2)
        items(cur) = items(cur) + 4
        GOSUB showstatus
        CASE ELSE
        IF mode = ORIG AND cur <> 1 THEN PLAY "l64o0ac": RETURN
        IF items(cur) = maxitems THEN PLAY "l64o0ac": RETURN
        LOCATE y, x
        COLOR co(mode)
        PRINT CHR$(ob(mode) - (x >= 40 AND mode = ARRO))
        room$(cur, items(cur) + 1) = oc$(mode) + STR$(x)
        room$(cur, items(cur) + 2) = STR$(y)
        items(cur) = items(cur) + 2
        END SELECT
        GOSUB showstatus
RETURN

startwall:
mode = WALL2
x1 = x
y1 = y
RETURN

startblock:
mode = BLCK2
x1 = x
y1 = y
RETURN

UP:
FOR t = 1 TO 80
oldroom(t) = SCREEN(1, t)
NEXT t
GOSUB clearroom
COLOR 7
FOR t = 1 TO 80
LOCATE 20, t
IF oldroom(t) = ob(WALL) OR oldroom(t) = ob(BLCK) THEN
        PRINT CHR$(176)
ELSEIF oldroom(t) = ob(SPCE) OR oldroom(t) = 32 THEN
        PRINT CHR$(32)
ELSE
        PRINT CHR$(249)
END IF
NEXT t
RETURN

DN:
FOR t = 1 TO 80
oldroom(t) = SCREEN(20, t)
NEXT t
GOSUB clearroom
COLOR 7
FOR t = 1 TO 80
LOCATE 1, t
IF oldroom(t) = ob(WALL) OR oldroom(t) = ob(BLCK) THEN
        PRINT CHR$(176)
ELSEIF oldroom(t) = ob(SPCE) OR oldroom(t) = 32 THEN
        PRINT CHR$(32)
ELSE
        PRINT CHR$(249)
END IF
NEXT t
RETURN

LT:
FOR t = 1 TO 20
oldroom(t) = SCREEN(t, 1)
NEXT t
GOSUB clearroom
COLOR 7
FOR t = 1 TO 20
LOCATE t, 80
IF oldroom(t) = ob(WALL) OR oldroom(t) = ob(BLCK) THEN
        PRINT CHR$(176)
ELSEIF oldroom(t) = ob(SPCE) OR oldroom(t) = 32 THEN
        PRINT CHR$(32)
ELSE
        PRINT CHR$(249)
END IF
NEXT t
RETURN

RT:
FOR t = 1 TO 20
oldroom(t) = SCREEN(t, 80)
NEXT t
GOSUB clearroom
COLOR 7
FOR t = 1 TO 20
LOCATE t, 1
IF oldroom(t) = ob(WALL) OR oldroom(t) = ob(BLCK) THEN
        PRINT CHR$(176)
ELSEIF oldroom(t) = ob(SPCE) OR oldroom(t) = 32 THEN
        PRINT CHR$(32)
ELSE
        PRINT CHR$(249)
END IF
NEXT t
RETURN

'set up user interface
drawmenu:

COLOR 7, 0
 CLS
 LOCATE 21, 1
 FOR t = 1 TO 80: PRINT CHR$(178); : NEXT t
 FOR t = 1 TO 80: PRINT CHR$(177); : NEXT t
 FOR t = 1 TO 80: PRINT CHR$(176); : NEXT t

COLOR 15
LOCATE 21, 2
PRINT "Walls"
LOCATE 22, 2
PRINT "Blocks"
LOCATE 22, 60
PRINT "UP-DN-LT-RT"
LOCATE 21, 45
PRINT "LOAD   SAVE"
LOCATE 21, 75
PRINT " NEW"
LOCATE 23, 75
PRINT "EXIT"
LOCATE 22, 75
PRINT "PLAY"
LOCATE 23, 2: COLOR co(SPCE): PRINT CHR$(ob(SPCE))
LOCATE 23, 5: COLOR co(PONT): PRINT CHR$(ob(PONT))

t = 5

FOR i = 10 TO 30 STEP 10
  FOR j = 21 TO 23
    LOCATE j, i: COLOR co(t): PRINT CHR$(ob(t))
    t = t + 1
  NEXT j
NEXT i

LOCATE 21, 40: COLOR co(MINE): PRINT CHR$(ob(MINE))
LOCATE 22, 40: COLOR co(ORIG): PRINT CHR$(ob(ORIG))

RETURN

eraseobject:
FOR k = 1 TO items(cur) STEP 2
IF LEFT$(room$(cur, k), 1) = oc$(mode) THEN
        IF mode >= 3 THEN
                ox1 = VAL(RIGHT$(room$(cur, k), LEN(room$(cur, k)) - 1))
                oy1 = VAL(room$(cur, k + 1))
                IF ox1 = x AND oy1 = y THEN
                        position = k
                        GOSUB slideleft
                        GOSUB clearroom
                        GOSUB drawroom
                END IF
        END IF
        IF mode < 3 THEN
                ox1 = VAL(RIGHT$(room$(cur, k), LEN(room$(cur, k)) - 1))
                oy1 = VAL(room$(cur, k + 1))
                ox2 = VAL(room$(cur, k + 2))
                oy2 = VAL(room$(cur, k + 3))
                IF ox1 > ox2 THEN
                        q = ox1
                        ox1 = ox2
                        ox2 = q
                END IF
                IF oy1 > oy2 THEN
                        q = oy1
                        oy1 = oy2
                        oy2 = q
                END IF
                IF ox1 <= x AND ox2 >= x AND oy1 <= y AND oy2 >= y AND SCREEN(y, x) = ob(mode) THEN
                        position = k: GOSUB slideleft
                        GOSUB slideleft
                        GOSUB clearroom
                        GOSUB drawroom
                END IF
        END IF
        GOSUB showstatus
END IF

NEXT k
RETURN

slideleft:
FOR i = position TO items(cur) STEP 2
        IF NOT (i >= (maxitems - 2)) THEN
          room$(cur, i) = room$(cur, i + 2)
          room$(cur, i + 1) = room$(cur, i + 3)
        END IF
NEXT i
items(cur) = items(cur) - 2
RETURN

clearroom:
 LOCATE 1, 1
 FOR i = 1 TO 20        'clear map
        FOR j = 1 TO 80
                PRINT " ";
        NEXT j
 NEXT i
RETURN

drawroom:

 IF items(cur) = 0 THEN RETURN
 t = 0
 DO 'Figure out the stuff that's in the room
  F$ = room$(cur, t + 1)
  x1 = VAL(RIGHT$(F$, LEN(F$) - 1))
  y1 = VAL(room$(cur, t + 2))
  IF t <= 96 THEN
   x2 = VAL(room$(cur, t + 3))
   y2 = VAL(room$(cur, t + 4))
  END IF
  SELECT CASE LEFT$(F$, 1)
   CASE "l" 'Walls ("l" for line)
     Drlin x1, y1, x2, y2
   CASE "b" 'Big blue blocks
     Drblock x1, y1, x2, y2
   CASE "s" 'For putting spaces in walls.
     COLOR 7
     LOCATE y1, x1
     PRINT CHR$(115)
   CASE "p" 'Plot a single point
     LOCATE y1, x1
     COLOR 7
     PRINT CHR$(219)
   CASE "w" 'Warp tile
     LOCATE y1, x1
     COLOR 12
     PRINT CHR$(176)
     COLOR 7
   CASE "c" 'diamonds ("d" was already used for doors.)
     LOCATE y1, x1
     COLOR 15
     PRINT CHR$(4)
     COLOR 7
   CASE "k" 'Keys
     LOCATE y1, x1
     COLOR 14
     PRINT CHR$(244)
     COLOR 7
   CASE "d" 'Doors
     LOCATE y1, x1
     COLOR 6
     PRINT CHR$(8)
     COLOR 7
   CASE "e" 'Enemies
     LOCATE y1, x1
     COLOR 4
     PRINT CHR$(234)
   CASE "v" 'Continue point ("v" was a random choice)
     COLOR 11
     LOCATE y1, x1
     PRINT CHR$(21)
     COLOR 7
   CASE "Q" 'End of the game marker
     COLOR 13
     LOCATE y1, x1
     PRINT CHR$(5)
     COLOR 7
   CASE "a" 'arrows
     LOCATE y1, x1
     COLOR 2
      IF SCREEN(y1, x1 - 1) <> 32 THEN
      PRINT CHR$(16)
     ELSEIF SCREEN(y1, x1 + 1) <> 32 THEN
      PRINT CHR$(17)
     ELSE
      PRINT CHR$(16 - (x1 >= 40))
     END IF
   CASE "m" 'boMbs
     LOCATE y1, x1:
     COLOR 13
     PRINT CHR$(127)
   CASE "n" 'miNes
     COLOR 7
     LOCATE y1, x1
     PRINT CHR$(233)
   CASE "o" 'origin
     LOCATE y1, x1
     COLOR co(ORIG)
     PRINT CHR$(ob(ORIG))
  END SELECT
 t = t + 2
 LOOP UNTIL t = items(cur)
RETURN

save:
    GOSUB clearroom
    LOCATE 1, 1
    COLOR 15
    DO
    INPUT "Enter Filename for saving (8 characters): "; n$
    LOOP WHILE LEN(n$) < 1 AND LEN(n$) > 8
    n$ = n$ + ".dat"
resave:
    OPEN n$ FOR OUTPUT AS #1
    FOR i = 1 TO 30
        PRINT #1, STR$(items(i))
        FOR j = 1 TO items(i)
                PRINT #1, room$(i, j)
        NEXT j
    NEXT i
    CLOSE
    GOSUB clearroom
    LOCATE 1, 1
    COLOR 15

PRINT "Your file, " + n$ + ", has been saved."

OPEN "editor.ini" FOR OUTPUT AS #1
PRINT #1, n$
CLOSE #1

SLEEP 2
GOSUB clearroom
GOSUB drawroom
RETURN

new:
    GOSUB clearroom
    LOCATE 1, 1
    COLOR 15
    DO
    INPUT "Enter New Filename (8 characters or less): "; n$
    LOOP WHILE LEN(n$) < 1 AND LEN(n$) > 8
    n$ = n$ + ".dat"
GOTO resave

load:
    GOSUB clearroom
    LOCATE 1, 1
    COLOR 15
    DO
    INPUT "Enter Filename for loading (8 characters or less): "; n$
    LOOP WHILE LEN(n$) < 1 AND LEN(n$) > 8
    n$ = n$ + ".dat"
reload:
    OPEN n$ FOR INPUT AS #1
    i = 1
    DO
        INPUT #1, k$
        IF k$ = "*" THEN
                items(i) = 0
                j = 1
                DO
                        INPUT #1, room$(i, j)
                        j = j + 1
                        items(i) = items(i) + 1
                LOOP WHILE room$(i, j - 1) <> "*" AND items(i) < 99
                items(i) = items(i) - 1
        ELSE
                items(i) = VAL(k$)
                FOR j = 1 TO items(i)
                        INPUT #1, room$(i, j)
                NEXT j
        END IF
    i = i + 1
    LOOP WHILE i <= 30 AND NOT EOF(1)
    CLOSE
GOSUB clearroom
GOSUB drawroom
RETURN

SUB Drblock (x1, y1, x2, y2)
COLOR 9

IF x1 > x2 THEN
 t = x1
 x1 = x2
 x2 = t
END IF

IF y1 > y2 THEN
 t = y1
 y1 = y2
 y2 = t
END IF

LOCATE y1, x1
 FOR t = 0 TO y2 - y1
  FOR r = 0 TO x2 - x1
   LOCATE y1 + t, x1 + r
   PRINT CHR$(177);
  NEXT
 NEXT
COLOR 7
END SUB

SUB Drlin (x1, y1, x2, y2)

 COLOR 7

 dy = y2 - y1: dx = x2 - x1: yc = y2: xc = x2

IF dx = 0 THEN
 FOR yc = y2 TO y1 STEP SGN(-dy)
  IF yc > 0 AND yc < 21 AND xc > 0 AND xc < 81 THEN
   LOCATE yc, xc
   PRINT CHR$(219)
  END IF
 NEXT yc
ELSE dd = dy / dx
 FOR xc = x2 TO x1 STEP SGN(-dx)
  tc = INT(dd * (xc - x2) + y2)
  DO WHILE tc <> yc
   yc = yc + SGN(-dy)
   IF yc > 0 AND yc < 21 AND xc > 0 AND xc < 81 THEN
    LOCATE yc, xc
    PRINT CHR$(219)
   END IF
  LOOP
  IF yc > 0 AND yc < 21 AND xc > 0 AND xc < 81 THEN
   LOCATE yc, xc
   PRINT CHR$(219)
  END IF
 NEXT xc
END IF
END SUB

FUNCTION vsINTERR% (a1%, a2%, a3%, a4%)

'----------------------------------------------------------------------------
SHARED mouse1() AS INTEGER

IF mouse1(0) <> 0 THEN
  a5% = VARPTR(mouse1%(0))
  DEF SEG = VARSEG(mouse1(0))
  POKE a5% + 26, &H33
  CALL ABSOLUTE(a1%, a2%, a3%, a4%, a5%)
  mouseInterr% = ax%
ELSE
  SCREEN 0
  PRINT : PRINT "Mouse error, program stopped"
  SYSTEM
END IF
'----------------------------------------------------------------------------
END FUNCTION

SUB vsMOUSE (action$, a1%, a2%, a3%, a4%)

'----------------------------------------------------------------------------
SHARED mouseX%, mouseY%, mouseb%

SELECT CASE action$
  CASE "get":      r% = vsINTERR%(3, mouseb%, mouseX%, mouseY%)
  CASE "show":     r% = vsINTERR%(1, bx%, cx%, dx%)
  CASE "hide":     r% = vsINTERR%(2, bx%, cx%, dx%)
  CASE "position": r% = vsINTERR%(4, bx%, a1%, a2%)
  CASE "area":     r% = vsINTERR%(7, 0, a1%, a2%)
                   r% = vsINTERR%(8, bx%, a3%, a4%)
  CASE "coord":    COLOR a3%
                   LOCATE a1%, a2%: PRINT "X"; mouseX%; "Y"; mouseY%; "    "
                   COLOR a4%
  CASE ELSE:       SCREEN 0
                   PRINT : PRINT "Error - Wrong mouse command"
                   SYSTEM
END SELECT
'----------------------------------------------------------------------------

END SUB