DECLARE SUB ReadQVAR (qvar$, val$)
DECLARE SUB WriteQVAR (qvar$, val$)
DECLARE SUB ViewEmployed ()
DECLARE SUB SaveUDT (path$, wld!)
DECLARE SUB LoadUDT (path$, wld!)
DECLARE SUB RefreshInv ()
DECLARE SUB Sell (sold!, shopno!)
DECLARE FUNCTION GetKW5$ (st$, fdiv!, eow!, mw2$, ew$, ew2$)
DECLARE FUNCTION GetUnit% (Name$)
DECLARE SUB CheckLevels ()
DECLARE SUB Lpalette ()
DECLARE FUNCTION GetKW2$ (st$, eow!, fdiv)
DECLARE FUNCTION GetKW3$ (st$, fdiv, eow, ew$)
DECLARE FUNCTION GetKW4$ (st$, fdiv, eow, mw2$, ew$)
DECLARE SUB Script (st$, retn!, oldname$, speaker)
DECLARE SUB Manual ()
DECLARE FUNCTION EmptySlots! ()
DECLARE FUNCTION AINPUT$ (prompt$, Init$)
DECLARE FUNCTION GetID% (ID$)
DECLARE SUB MiniDigit (X!, Y!, t$, C!)
DECLARE SUB Buy (bought!, shopno)
DECLARE FUNCTION YesNo% (MSGT$, yes$, no$)
DECLARE FUNCTION AINPUT$ (prompt$, Init$)
DECLARE FUNCTION FString$ (Offset!)
DECLARE SUB Give (ID$, Amt!)
DECLARE SUB SaveBDT (file2$)
DECLARE SUB LoadDlg (pname$, lmode)
DECLARE SUB LoadGame (pname$)
DECLARE SUB SaveGame (pname$)
DECLARE SUB ExitGame ()
DECLARE FUNCTION Possess& (ID!)
DECLARE FUNCTION GetInvNo% (ID!)
'$INCLUDE: 'cdm.bi' 'interface
' FutureTileEngine
'$INCLUDE: 'future.bi'
RANDOMIZE TIMER

SUB AddPlayer
 ' get number of players already
 ' gets last free slot at same time
 FOR i = 1 TO 50'maxno of units
  IF Unit(i).Rank = 1 THEN
   nplayas = nplayas + 1
  END IF
  IF Unit(i).Rank = 0 AND Unit(i).HP = 0 THEN
   frees = i
  END IF
 NEXT i
 IF frees > 0 THEN
  playerno = nplayas
  'CreateGuy 8, 5, 1, 1, 1, 0, 0, 0, 8, 50, "", Icon
  MSG "A new player has entered the game"
 ELSE
  MSG "Max players reached"
 END IF

END SUB

FUNCTION AINPUT$ (prompt$, Init$)

X = 300
Y = 200
line$ = Init$
GOSUB redraw4
DO
 jkl$ = INKEY$
 SELECT CASE jkl$
  CASE CHR$(27)
   AINPUT$ = ""
   EXIT FUNCTION
  CASE CHR$(13)
   AINPUT$ = line$
   EXIT FUNCTION
  CASE CHR$(8)
   IF line$ <> "" THEN
    line$ = LEFT$(line$, LEN(line$) - 1)
    GOSUB redraw4
   END IF
  CASE ELSE
  IF jkl$ <> "" THEN
   line$ = line$ + jkl$
   GOSUB redraw4
  END IF
 END SELECT
LOOP
redraw4:
 Future.FILLBOX X, Y, X + 200, Y + 100, 8
 Future.BOX X, Y, X + 200, Y + 100, 7
 Future.PRINT X + 20, Y + 20, prompt$ + ":", 173, -1
 Future.PRINT X + 20, Y + 40, "                   ", 173, 0
 Future.PRINT X + 20, Y + 40, line$ + "Û", 173, 0
RETURN



END FUNCTION

SUB Buy (bought, shopno)
REDIM buyID(36)
REDIM buyAmt(36)
DIM cost AS LONG
CLOSE
OPEN "data\buy" + LTRIM$(STR$(shopno)) + ".dat" FOR INPUT AS #1
DO UNTIL EOF(1)
 i = i + 1
 INPUT #1, ID$, buyAmt(i)
 buyID(i) = GetID%(ID$)
LOOP
CLOSE
i = 0
redrawbuy:
Future.MouseOff
X1 = 33
Y1 = 16
x2 = 360
Y2 = 328
Future.FILLBOX X1, Y1, x2, Y2, 8
Future.BOX X1, Y1, x2, Y2, 7
Future.PRINT X1 + 40, Y1 + 1, " Buy...", 12, -1
FOR X = 1 TO 6
 FOR Y = 1 TO 6
  x2 = X * 36
  Y2 = Y * 36
  item = (Y * 6) - (6 - X)
  IF buyID(item) > 0 THEN
   iconP% = obj(buyID(item)).Icon
   Future.XMSArrayPut x2 + 0, Y2 + 0, icons%, iconP%
    MiniDigit x2, Y2 + 22, STR$(buyAmt(item)), 14
    cost = obj(buyID(item)).cost * (1 + (market! / 100))
    cost = cost + INT(cost * -(obj(buyID(ibuy)).demand / 100))
    MiniDigit x2, Y2 + 28, STR$(cost), 10
  END IF
 NEXT Y
NEXT X

Future.MouseOn
  cost = 0
  DO
   Future.UpdateMouse
   IF Future.MouseB% = 1 THEN
    DO
     Future.UpdateMouse
    LOOP UNTIL Future.MouseB% = 0
    mx% = Future.MouseX%
    my% = Future.MouseY%
    mxs = INT(mx% / 36)
    mys = INT(my% / 36)
    ibuy = (mys * 6) - (6 - mxs)
    IF ibuy < 1 OR ibuy > 36 THEN ibuy = 1
    IF buyID(ibuy) > 0 THEN
    Amt = VAL(AINPUT$("Amount to buy:", "1"))
    IF Amt > buyAmt(ibuy) THEN Amt = buyAmt(ibuy)
    cost = obj(buyID(ibuy)).cost * (1 + (market! / 100)) * Amt
    cost = cost + INT(cost * -(obj(buyID(ibuy)).demand / 100))
    gold = GetInvNo%(INT(GetID%("gold")))
    free = EmptySlots
    IF invAmt(gold) >= cost THEN
     IF invAmt(gold) = cost THEN free = free + 1
     IF free >= Amt THEN
      IF YesNo%("Buy this " + LTRIM$(RTRIM$(obj(buyID(ibuy)).oname$)) + " for" + STR$(cost) + "GP?", "Yes", "No") = 1 THEN
       invAmt(gold) = invAmt(gold) - cost
       IF invAmt(gold) = 0 THEN invID(gold) = 0
       obj(buyID(ibuy)).demand = obj(buyID(ibuy)).demand - Amt
       IF obj(buyID(ibuy)).Group = 4 THEN
        Give obj(buyID(ibuy)).ID$, Amt
       ELSE
        FOR i = 1 TO Amt
         Give obj(buyID(ibuy)).ID$, 1
        NEXT i
       END IF
       GOSUB redrawbuy
       EXIT DO
      END IF
      GOSUB redrawbuy
     ELSE
      MSG "Not enough room"
      GOSUB redrawbuy
     END IF
    ELSE
     MSG "Not enough gold; you need" + STR$(cost) + "GP"
     GOSUB redrawbuy
    END IF
    END IF
   END IF
   jkl$ = INKEY$
   SELECT CASE jkl$
    CASE CHR$(27)
     EXIT DO
   END SELECT
  LOOP

END SUB

FUNCTION GetKW2$ (st$, eow, fdiv)
   eow2 = INSTR(eow + 1, st$, "_")
   IF fdiv = 0 THEN
    mw$ = MID$(st$, eow + 1)
   ELSE
    mw$ = MID$(st$, eow + 1, fdiv - eow - 1)
   END IF
   GetKW2$ = mw$
END FUNCTION

FUNCTION GetKW3$ (st$, fdiv, eow, ew$)
 eow2 = INSTR(eow + 1, st$, "_")
 mw$ = MID$(st$, eow + 1, eow2 - eow - 1)
 IF fdiv = 0 THEN
  ew$ = MID$(st$, eow2 + 1)
 ELSE
  ew$ = MID$(st$, eow2 + 1, fdiv - eow2 - 1)
 END IF
 GetKW3$ = mw$
END FUNCTION

FUNCTION GetKW4$ (st$, fdiv, eow, mw2$, ew$)
 eow2 = INSTR(eow + 1, st$, "_")
 eow3 = INSTR(eow2 + 1, st$, "_")
 mw$ = MID$(st$, eow + 1, eow2 - eow - 1)
 mw2$ = MID$(st$, eow2 + 1, eow3 - eow2 - 1)
 IF fdiv > 0 THEN
  ew$ = MID$(st$, eow3 + 1, fdiv - eow3 - 1)
 ELSE
  ew$ = MID$(st$, eow3 + 1)
 END IF
 GetKW4$ = mw$
END FUNCTION

FUNCTION GetKW5$ (st$, fdiv, eow, mw2$, ew$, ew2$)
 eow2 = INSTR(eow + 1, st$, "_")
 eow3 = INSTR(eow2 + 1, st$, "_")
 eow4 = INSTR(eow3 + 1, st$, "_")
 mw$ = MID$(st$, eow + 1, eow2 - eow - 1)
 mw2$ = MID$(st$, eow2 + 1, eow3 - eow2 - 1)
 ew2$ = MID$(st$, eow3 + 1, eow4 - eow3 - 1)
 IF fdiv > 0 THEN
  ew$ = MID$(st$, eow4 + 1, fdiv - eow4 - 1)
 ELSE
  ew$ = MID$(st$, eow4 + 1)
 END IF
 GetKW5$ = mw$
END FUNCTION

FUNCTION GetUnit% (Name$)
 FOR i = 1 TO 100
  IF RTRIM$(Unit(i).Name$) = RTRIM$(Name$) THEN
   GetUnit% = i
   EXIT FOR
  END IF
 NEXT i
END FUNCTION

SUB LoadDlg (pname$, lmode)
 'SHELL "dir player\* /b /a:d /o:n > dir.tmp"
 REDIM file$(200)
 CLOSE
 IF lmode = 1 THEN
  z = 1
  file$(z) = "[New]"
 END IF
 OPEN "savs.tmp" FOR APPEND AS #1: CLOSE
 OPEN "savs.tmp" FOR INPUT AS #1
 DO UNTIL EOF(1)
  z = z + 1
  INPUT #1, file$(z)
 LOOP
 CLOSE
 nfiles = z
 sf = 1
 scroll = 0
 max = 20
 preview = 0
 CLOSE
 GOSUB redraw
 DO
  jkl$ = INKEY$
  SELECT CASE jkl$
   CASE CHR$(27)
    CLOSE
    EXIT SUB
   CASE CHR$(13)
    CLOSE
    IF lmode = 1 AND sf = 1 THEN
      pname$ = AINPUT$("File:", "")
    ELSE
     pname$ = file$(sf)
    END IF
    IF lmode = 0 THEN pname$ = file$(sf)
    EXIT SUB
   CASE CHR$(0) + "H"
    IF sf <= 1 THEN
     sf = nfiles
     scroll = sf - 1
    ELSE
     sf = sf - 1
     IF sf - scroll + 1 = 1 AND scroll > 0 THEN
     scroll = scroll - 1
     END IF
    END IF
    GOSUB redraw
   CASE CHR$(0) + "P"
    IF sf > nfiles THEN
     sf = nfiles
    ELSE
     sf = sf + 1
     IF sf - scroll - 1 = max AND scroll < nfiles THEN
      scroll = scroll + 1
     END IF
    END IF
    GOSUB redraw
   CASE "m"
    file$(sf) = AINPUT$("File", "")
    GOSUB redraw
   CASE ELSE
    IF jkl$ <> "" THEN
     FOR i = sf + 1 TO max
      IF file$(i) <> "" THEN
       IF LCASE$(LEFT$(file$(i), 1)) = LCASE$(jkl$) THEN
        sf = i
        scroll = sf - 1
        EXIT FOR
       END IF
      END IF
     NEXT i
     GOSUB redraw
    END IF
  END SELECT
 LOOP
redraw:
 Future.FILLBOX 40, 40, 600, 440, 8
 Future.BOX 40, 40, 600, 440, 7
 FOR i = 1 TO max
  f = i + scroll
  IF sf = f THEN C = 0: c2 = 168 ELSE C = 173: c2 = 167
  Future.PRINT 50, 50 + (i * 16), file$(f), C + 0, c2 + 0
 NEXT i
 CLOSE
RETURN
 

END SUB

SUB LoadGame (pname$)
CLOSE
IF pname$ = "new_game" THEN
 path$ = "maps\"
ELSE
 path$ = "player\" + pname$ + "\"
END IF
OPEN path$ + pname$ + ".pdt" FOR INPUT AS #1
 INPUT #1, currentmap, seli, pn, world
 IF pname$ = "new_game" AND playerno < 2 THEN
  playerno = pn
 END IF
 INPUT #1, TIME, YEAR, Xscroll%, Yscroll%
 FOR i = 1 TO 36
  INPUT #1, invID(i), invAmt(i)
 NEXT i
 FOR i = 1 TO 100
  INPUT #1, bankID(i), bankAmt(i)
 NEXT i
 INPUT #1, haircol, shirtcol, pantscol, swordcol, shieldcol
 INPUT #1, qstage, good, evil
CLOSE
OPEN path$ + pname$ + ".dat" FOR RANDOM AS #1
FOR i = 1 TO 14
 GET #1, , Skill(i)
NEXT i
FOR i = 1 TO 8
 GET #1, , Worn(i)
NEXT i
LoadUDT path$, world
world$ = path$ + "world" + STR$(world) + ".bd3"
END SUB

SUB LoadUDT (path$, wld)
CLOSE
OPEN path$ + "ud" + STR$(wld) + ".udt" FOR RANDOM AS #1
FOR i = 1 TO 100
 GET #1, , Unit(i)
NEXT i
FOR i = 1 TO 100
 GET #1, , plot(i)
NEXT i
CLOSE
END SUB

SUB MainMenu (flag)
redrawmainmenu:
 Future.CLS 0
 'FOR X = 0 TO 19
 ' FOR Y = 0 TO 19
 '  Future.XMSArrayPut X * 32, Y * 32, icons%, 55
 ' NEXT Y
 'NEXT X
 SetPage Primary%
 ViewPage Secondary%
 Future.LoadBMP "menu.bmp", 0, 0
 ViewPage Primary%
 X = 260
 IF flag < 4 THEN Future.PRINT 20, 440, "Press Space to Return to Game", 245, -1
 DO
  Future.UpdateMouse
  jkl$ = INKEY$
  SELECT CASE jkl$
   CASE "l"
    LoadTiles
    ViewPage Primary%
    SetPage Primary%
   CASE "2"
    LoadDlg pname$, 0
    IF pname$ <> "" THEN
     Lpalette
     LoadGame pname$
     flag = 1
     EXIT DO
    END IF
    GOSUB redrawmainmenu
   CASE "n"
    playerno = VAL(AINPUT$("Player #", "1"))
    GOSUB redrawmainmenu
   CASE "1"
    TIME = 0
    YEAR = 0
    pname$ = ""
    LoadGame "new_game"
    qstage = 0
    flag = 2
    EXIT DO
   CASE "]"
    IF flag < 4 THEN
     SaveGame "new_game"
    END IF
    GOSUB redrawmainmenu
   CASE "4"
    Manual
    GOSUB redrawmainmenu
   CASE "3"
    LoadDlg pname$, 1
    IF pname$ <> "" THEN
     SaveGame pname$
    END IF
    GOSUB redrawmainmenu
   CASE " "
    IF flag < 4 THEN
     Lpalette
     EXIT DO
    END IF
   CASE CHR$(27), "5"
    ExitGame
  END SELECT
 LOOP

END SUB

SUB Manual
' this manual is dedicated to pon. cos... hes the type what needs it
SetMaskColor -2
Future.CLS 0
CLOSE
Y = 10
OPEN "data\manual.txt" FOR INPUT AS #1
DO UNTIL EOF(1)
 LINE INPUT #1, line$
 IF LEFT$(line$, 1) <> "'" THEN
  Y = Y + 17
  l = l + 1
  Future.PRINT 10, Y + 0, line$, 173, -1
  IF l = 25 THEN
   l = 0
   Y = 17
   DO: LOOP UNTIL INKEY$ <> ""
   Future.CLS 0
  END IF
 END IF
LOOP
FOR i = 1 TO 20000: NEXT i
CLOSE
DO: LOOP UNTIL INKEY$ <> ""
SetMaskColor 0
END SUB

SUB ReadQVAR (qvar$, val$)
 file$ = "data\qv.dat"
 ff = FREEFILE
 OPEN file$ FOR APPEND AS #ff
 CLOSE ff
 OPEN file$ FOR INPUT AS #ff
  DO UNTIL EOF(ff)
   INPUT #ff, pname2$, qv$, v$
   IF UCASE$(qv$) = UCASE$(qvar$) AND pname$ = pname2$ THEN
    val$ = v$
    CLOSE ff
    EXIT DO
   END IF
  LOOP
  CLOSE ff
END SUB

SUB SaveGame (pname$)
CLOSE
'SHELL "dir player\* /a:d /b > del.tmp"
OPEN "savs.tmp" FOR INPUT AS #1
DO UNTIL EOF(1)
 INPUT #1, N$
 IF pname$ = N$ THEN found = 1
LOOP
CLOSE
IF found = 0 AND pname$ <> "new_game" THEN
 MKDIR "player\" + pname$
 OPEN "savs.tmp" FOR APPEND AS #1
 WRITE #1, pname$
 CLOSE #1
END IF
IF pname$ = "new_game" THEN
 path$ = "maps\"
ELSE
 path$ = "player\" + pname$ + "\"
END IF
OPEN path$ + pname$ + ".pdt" FOR OUTPUT AS #1
 WRITE #1, currentmap, seli, playerno, world
 IF pname$ = "new_game" THEN TIME = 0: YEAR = 0
 WRITE #1, TIME, YEAR, Xscroll%, Yscroll%
 FOR i = 1 TO 36
  WRITE #1, invID(i), invAmt(i)
 NEXT i
 FOR i = 1 TO 100
  WRITE #1, bankID(i), bankAmt(i)
 NEXT i
  WRITE #1, haircol, shirtcol, pantscol, swordcol, shieldcol
  WRITE #1, qstage, good, evil
CLOSE
OPEN path$ + pname$ + ".dat" FOR RANDOM AS #1
FOR i = 1 TO 14
 PUT #1, , Skill(i)
NEXT i
FOR i = 1 TO 8
 PUT #1, , Worn(i)
NEXT i
 SaveUDT path$, world
 SaveBDT (path$ + "world" + STR$(world) + ".bd3")
END SUB

SUB SaveUDT (path$, wld)
CLOSE
OPEN path$ + "ud" + STR$(wld) + ".udt" FOR RANDOM AS #1
FOR i = 1 TO 100
 IF pname$ = "new_game" THEN
  IF Unit(i).Rank <> 19 THEN Unit(i).MVT = 0 ELSE Unit(i).MVT = 15
 END IF
 IF Unit(i).Rank = -1 THEN ' save null unit if rank=-1
  PUT #1, , Unit(0)
 ELSE
  PUT #1, , Unit(i)
 END IF
NEXT i
FOR i = 1 TO 100
 PUT #1, , plot(i)
NEXT i
CLOSE

END SUB

SUB Says (who$, sno, speaker)
ON LOCAL ERROR GOTO 40
DIM X AS INTEGER
1
resay:
2
realqs = qstage
saydfolt:
ret = 0
ff = FREEFILE
sts = 0
f = 0
OPEN "quest\" + who$ + ".dat" FOR INPUT AS #ff
 DO UNTIL EOF(ff)
  INPUT #ff, qs, q$, a1$, na1$, a2$, na2$
  IF qs = realqs THEN
   sts = sts + 1
   IF sno = sts THEN
    f = 1
    EXIT DO
   END IF
  END IF
 LOOP
 IF f = 0 THEN
  IF realqs >= 0 THEN
   realqs = -1
   GOSUB saydfolt
  ELSE
   Drawmap currentmap, 1, 0, 0
   EXIT SUB
  END IF
 END IF
CLOSE #ff

IF INSTR(q$, "%") > 0 THEN
 Script MID$(q$, 2), ret, who$, speaker
 EXIT SUB
END IF
  
Future.FILLBOX 1, 375, 600, 479, 220
Future.BOX 1, 375, 599, 479, 20

3
GOSUB saybrd

DO
 jkl$ = INKEY$
 SELECT CASE jkl$
  CASE CHR$(0) + "H"
   IF ans = 1 THEN ans = 0 ELSE ans = 1
   GOSUB saybrd
  CASE CHR$(0) + "P"
   IF ans = 1 THEN ans = 0 ELSE ans = 1
   GOSUB saybrd
  CASE CHR$(27)
   MainMenu 1
   Lpalette
   Drawmap currentmap, 1, 0, 0
   GOSUB saybrd
  CASE CHR$(13), " "
   IF ans = 1 THEN
4
    Script na2$, ret, who$, speaker
   ELSE
5
    Script na1$, ret, who$, speaker
   END IF
   IF ret = 1 THEN
    Unit(1).mode = 0
    MSG ""
    Drawmap currentmap, 1, 0, 0
    EXIT SUB
   END IF
   IF ret = 0 THEN MSG "": EXIT SUB
   IF ret < 0 THEN
    sno = ABS(ret)
    GOSUB resay
   END IF
 END SELECT
LOOP


saybrd:
 Y = 0
 Future.BOX 3, 377, 597, 477, 26
 Future.BOX 5, 378, 596, 476, 23
 Future.BOX 6, 379, 595, 475, 20

 Future.XMSArrayPut 0, 360, sprs%, 13
 FOR i = 1 TO 39
  Future.XMSArrayPut (i * 15), 360, sprs%, 17
 NEXT i
 FOR i = 0 TO 7
  Future.XMSArrayPut 0, 375 + (i * 15), sprs%, 14
 NEXT i
 IF ans = 1 THEN hlc = 10 ELSE hlc = 121
 Future.PRINT 20, 459 - Y, a2$, hlc + 0, 220
 Y = Y + 17
 IF ans = 0 THEN hlc = 10 ELSE hlc = 121
 Future.PRINT 20, 459 - Y, a1$, hlc + 0, 220
 IF LEN(q$) < 65 THEN
  Y = Y + 17
  Future.PRINT 20, 459 - Y, q$, 14, 220
 ELSE
  split = INSTR(q$, "@")
  IF split = 0 THEN split = 65
  Y = Y + 17
  Future.PRINT 20, 459 - Y, MID$(q$, split + 1), 14, 220
  Y = Y + 17
  Future.PRINT 20, 459 - Y, LEFT$(q$, split - 1), 14, 220
 END IF
 Y = Y + 32
 Future.PRINT 20, 459 - Y, UCASE$(who$), 12, 220

 Future.FILLBOX 0, 322, 38, 360, 22
 Future.FILLBOX 3, 325, 35, 357, 17
 X = 3
 SELECT CASE RTRIM$(who$)
  CASE "orc", "karn", "tharg"
   Future.XMSArrayPut X, 325, handle%, 1
  CASE "guard"
   Future.XMSArrayPut X, 325, handle%, 2
  CASE "soldier"
   Future.XMSArrayPut X, 325, handle%, 3
  CASE "trainer"
   Future.XMSArrayPut X, 325, handle%, 4
  CASE "young"
   Future.XMSArrayPut X, 325, handle%, 5
  CASE "arnold"
   Future.XMSArrayPut X, 325, handle%, 6
  CASE "citizen"
   SELECT CASE Unit(speaker).Icon
    CASE 10
     Future.XMSArrayPut X, 325, handle%, 7
    CASE 9
     Future.XMSArrayPut X, 325, handle%, 9
    CASE 8
     Future.XMSArrayPut X, 325, handle%, 10
   END SELECT
  CASE ELSE
   Future.XMSArrayPut X, 325, handle%, 7
 END SELECT

RETURN

40
 SLEEP
 ResetScreen
 PRINT "error in Says line "; ERL; "err#"; ERR
 ERROR ERR
 SLEEP
 SYSTEM
END SUB

SUB Script (st$, retn, oldname$, speaker)

 ON LOCAL ERROR GOTO 41

 eow = INSTR(st$, "_")
 IF eow = 0 THEN MSG "Bad script" + st$: EXIT SUB
 fdiv = INSTR(st$, "&")
18
 kw$ = LEFT$(st$, eow - 1)
19
 IF fdiv > 0 THEN kw2$ = MID$(st$, fdiv + 1)
20
 SELECT CASE LCASE$(kw$)
  CASE "clone"
   X$ = GetKW5$(st$, fdiv, eow, Y$, n2$, N$)
   IF INSTR(N$, ".") > 0 THEN N$ = Unit(speaker).Name$
   pnt = GetUnit%(RTRIM$(N$))
   cm = Unit(pnt).Map
   ct = Unit(pnt).Team
   cr = Unit(pnt).Rank
   ctx = Unit(pnt).Tx
   cty = Unit(pnt).Ty
   ctm = Unit(pnt).TM
   chp = Unit(pnt).HP
   ic% = Unit(pnt).Icon
   cspd = Unit(pnt).Spd
   CreateGuy VAL(X$), VAL(Y$), cm, ct, cr, ctx, cty, ctm, chp, cspd, n2$, ic%
  CASE "unit"
   X$ = GetKW4$(st$, fdiv, eow, Y$, N$)
   CreateGuy 1, 1, 1, 2, VAL(X$), 0, 0, 0, 30, 6, N$, INT(VAL(Y$))
  CASE "targetai"
   mw$ = GetKW2$(st$, eow, fdiv)
   IF INSTR(mw$, ".") > 0 THEN mw$ = STR$(speaker)
   Unit(selu).TM = VAL(mw$)
  CASE "targetplayer"
   Unit(speaker).Tx = Unit(1).X
   Unit(speaker).Ty = Unit(1).Y
   Unit(speaker).TM = 1
  CASE "dmap"
   Drawmap currentmap, 1, 0, 0
  CASE "fade"
   FOR i = 1 TO 10
    Palette.FadeOut
   NEXT i
  CASE "palette"
   Lpalette
  CASE "finish"
   retn = 1
   EXIT SUB
  CASE "msg"
   mw$ = GetKW2$(st$, eow, fdiv)
   MSG mw$
  CASE "setqs"
   mw$ = GetKW2$(st$, eow, fdiv)
   qstage = VAL(mw$)
  CASE "cmap"
   mw$ = GetKW2$(st$, eow, fdiv)
   currentmap = VAL(mw$)
  CASE "scroll"
   mw$ = GetKW3$(st$, fdiv, eow, ew$)
   Xscroll% = VAL(mw$)
   Yscroll% = VAL(ew$)
  CASE "evil"
   mw$ = GetKW2$(st$, eow, fdiv)
   evil = evil + VAL(mw$)
  CASE "good"
   mw$ = GetKW2$(st$, eow, fdiv)
   good = good + VAL(mw$)
  CASE "team"
   mw$ = GetKW2$(st$, eow, fdiv)
   Unit(1).Team = VAL(mw$)
  CASE "run"
21
   mw$ = GetKW3$(st$, fdiv, eow, ew$)
   rscript = 0
   ff = FREEFILE
 '  MSG mw$ + " on" + STR$(ff)
   OPEN "quest\" + mw$ + ".cfg" FOR INPUT AS ff
22
   DO UNTIL EOF(ff)
    INPUT #ff, a$
    IF a$ = "_end" THEN rscript = 0
    IF rscript = 1 THEN
      cs = INSTR(a$, "(")
      ce = INSTR(a$, ")")
23
     IF cs > 0 THEN p$ = LEFT$(a$, cs - 1)
24
     SELECT CASE RTRIM$(p$)
      CASE "if"
       condition$ = MID$(RTRIM$(a$), cs + 1, ce - cs - 1)
       INPUT #ff, s1$
       INPUT #ff, s2$
       Script condition$, bool, oldname$, speaker
       IF bool = 2 THEN
        Script s1$, retn, oldname$, speaker
       ELSEIF bool = 3 THEN
        Script s2$, retn, oldname$, speaker
       END IF
      CASE ELSE
25
       IF INSTR(a$, "ssay") > 1 THEN CLOSE ff
       Script a$, retn2, oldname$, speaker
     END SELECT
    END IF
    IF a$ = ew$ THEN rscript = 1
   LOOP
 '  MSG STR$(ff) + " closed"
26
   CLOSE ff
  CASE "give"
   ID$ = GetKW3$(st$, fdiv, eow, Amt$)
   IF obj(GetID%(ID$)).Group = 4 THEN
    Give ID$, VAL(Amt$)
   ELSE
    FOR i = 1 TO VAL(Amt$)
     Give ID$, 1
    NEXT i
   END IF
  CASE "take"
   ID$ = GetKW3$(st$, fdiv, eow, Amt$)
   ob = GetID%(ID$)
   IF obj(ob).Group = 4 THEN
    obinv = GetID%(ID$)
    invAmt(obinv) = invAmt(obinv) - VAL(Amt$)
    IF invAmt(obinv) < 1 THEN invID(obinv) = 0
   ELSE
    tkn = 0
    FOR i = 1 TO 36
     IF ob = invID(i) THEN
      tkn = tkn + 1
      invID(i) = 0
      invAmt(i) = 0
      IF tkn = VAL(Amt$) THEN EXIT FOR
     END IF
    NEXT i
   END IF
  CASE "gotit"
   ID$ = GetKW3$(st$, fdiv, eow, Amt$)
   got = Possess&(GetID%(ID$) + 0)
   IF got >= VAL(Amt$) THEN
     retn = 2
   ELSE
     retn = 3
   END IF
  CASE "speaker"
   mw$ = GetKW2$(st$, eow, fdiv)
   un = VAL(mw$)
   IF un = speaker THEN
     retn = 2
   ELSE
     retn = 3
   END IF
  CASE "dead"
   ID$ = GetKW2$(st$, eow, fdiv)
   got = Unit(GetUnit%(ID$)).HP
   IF got <= 0 THEN
     retn = 2 'dead
   ELSE
     retn = 3 'not dead
   END IF
  CASE "mode"
   ID$ = GetKW3$(st$, fdiv, eow, Amt$)
   IF ID$ = "." THEN ID$ = STR$(speaker)
   Unit(VAL(ID$)).mode = VAL(Amt$)
  CASE "xp"
   ID$ = GetKW3$(st$, fdiv, eow, Amt$)
   Skill(VAL(ID$)).xp = Skill(VAL(ID$)).xp + VAL(Amt$)
   CheckLevels
  CASE "warp"
   X$ = GetKW4$(st$, fdiv, eow, Y$, p$)
   IF LEN(p$) > 3 THEN p$ = STR$(GetUnit%(p$))
   p = VAL(p$)
   Unit(p).X = VAL(X$)
   Unit(p).Y = VAL(Y$)
   Drawmap currentmap, 1, 0, 0
  CASE "target"
   X$ = GetKW4$(st$, fdiv, eow, Y$, p$)
   p = VAL(p$)
   Unit(p).Tx = VAL(X$)
   Unit(p).Ty = VAL(Y$)
  CASE "rclick"
   X$ = GetKW3$(st$, fdiv, eow, Y$)
   RClickSqr VAL(X$), VAL(Y$), 1
  CASE "hilite"
   X$ = GetKW4$(st$, fdiv, eow, Y$, C$)
   C = VAL(C$)
   hx = VAL(X$)
   hy = VAL(Y$)
   hx = (hx + 1) * 15
   hy = (hy + 1) * 15
   Future.CIRCLE hx - 7, hy - 7, 10, C + 0
  CASE "rank"
   mw$ = GetKW3$(st$, fdiv, eow, ew$)
   Rnk = VAL(ew$)
   IF mw$ = "." THEN mw$ = STR$(speaker)
   IF VAL(mw$) = 0 THEN
    IF mw$ = "." THEN mw$ = Unit(speaker).Name$
    pl = GetUnit%(RTRIM$(mw$))
    Unit(pl).Rank = Rnk
   ELSE
    pl = VAL(mw$)
    Unit(pl).Rank = Rnk
   END IF
  CASE "say"
   mw$ = GetKW3$(st$, fdiv, eow, ew$)
   snum = VAL(ew$)
   IF mw$ = "." THEN mw$ = oldname$
   'MSG "spkr:" + mw$
   'MSG "sentc:" + ew$
   oldname$ = mw$
   retn = -snum
   EXIT SUB
  CASE "ssay"
   mw$ = GetKW3$(st$, fdiv, eow, ew$)
   snum = VAL(ew$)
   IF mw$ = "." THEN mw$ = oldname$
   'MSG "spkr:" + mw$
   'MSG "sentc:" + ew$
   oldname$ = mw$
   retn = -snum
   Says oldname$, snum, speaker
  CASE "killall"
   mw$ = GetKW2$(st$, eow, fdiv)
   FOR i = 1 TO maxunits
    IF RTRIM$(Unit(i).Name$) = mw$ THEN
     Unit(i).mode = 0
     Unit(i).Tx = 0
     Unit(i).Ty = 0
     Unit(i).X = 0
     Unit(i).Y = 0
     Unit(i).TM = 0
     Unit(i).HP = 0
     Unit(i).Rank = 0
    END IF
   NEXT i
  CASE "mode2"
   mode$ = GetKW3$(st$, fdiv, eow, man$)
   FOR i = 1 TO maxunits
    IF RTRIM$(Unit(i).Name$) = man$ THEN
     Unit(i).mode = VAL(mode$)
     Unit(i).Tx = Unit(i).X
     Unit(i).Ty = Unit(i).Y
     Unit(i).TM = 0
    END IF
   NEXT i
  CASE "allagro"
   mw$ = GetKW3$(st$, fdiv, eow, ew$)
   ' ew$ is not used in this com nemore
   FOR i = 1 TO maxunits
    IF RTRIM$(Unit(i).Name$) = mw$ THEN
     Unit(i).mode = 31
     Unit(i).Tx = Unit(i).X
     Unit(i).Ty = Unit(i).Y
     Unit(i).TM = 0
    END IF
   NEXT i
  CASE "recruit"
   bar = Skill(6).Amt
   IF INT(RND * 15) < bar THEN
    retn = 2
   ELSE
    retn = 3
   END IF
  CASE "qvput"
   mw$ = GetKW3$(st$, fdiv, eow, ew$)
   WriteQVAR mw$, ew$
  CASE "qvadd"
   mw$ = GetKW3$(st$, fdiv, eow, ew$)
   ReadQVAR mw$, cv$
   nv = VAL(cv$) + VAL(ew$)
   WriteQVAR mw$, STR$(nv)
  CASE "qvequals"
   mw$ = GetKW3$(st$, fdiv, eow, ew$)
   ReadQVAR mw$, qval$
   IF qval$ = ew$ THEN
    retn = 2
   ELSE
    retn = 3
   END IF
  CASE "qvenough"
   mw$ = GetKW3$(st$, fdiv, eow, ew$)
   ReadQVAR mw$, qval$
   IF VAL(qval$) >= VAL(ew$) THEN
    retn = 2
   ELSE
    retn = 3
   END IF
  CASE ELSE
   MSG "Bad script keyword :" + kw$
 END SELECT
 IF kw2$ <> "" THEN Script kw2$, retn, oldname$, speaker
 EXIT SUB
41
 SLEEP
 ResetScreen
 PRINT "error in Script line "; ERL; "err#"; ERR
 PRINT "statement was " + st$ + " on keyword " + kw$
 PRINT "Next free file number is #"; FREEFILE
 ERROR ERR
 SLEEP
 RESUME 42
42
 SYSTEM

END SUB

SUB Sell (sold, shopno)
REDIM buyID(36)
REDIM buyAmt(36)
REDIM sellID(36)
REDIM sellAmt(36)

DIM cost AS LONG, tot AS LONG, Amt AS LONG
resetSell:
CLOSE
OPEN "data\buy" + LTRIM$(STR$(shopno)) + ".dat" FOR INPUT AS #1
DO UNTIL EOF(1)
 i = i + 1
 INPUT #1, ID$, buyAmt(i)
 buyID(i) = GetID%(ID$)
 ininv = GetInvNo%(buyID(i))
  IF ininv > 0 THEN
   nos = nos + 1
   sellID(nos) = buyID(i)
   sellAmt(nos) = Possess(sellID(nos))
  END IF
LOOP
CLOSE

'===================
'reset sell arrays if at general store
' to allow all items to be sold
' basically, just shows your inventory
IF shopno = 0 THEN
FOR i = 1 TO 36
 sellID(i) = 0
 sellAmt(i) = 0
 IF invID(i) <> GetID%("gold") THEN ' cant sell gold, well not money
  sellID(i) = invID(i)
  sellAmt(i) = invAmt(i)
 END IF
NEXT i
END IF
'======================= 5/6/05
i = 0
redrawsell:
Future.MouseOff
X1 = 33
Y1 = 16
x2 = 360
Y2 = 328
Future.FILLBOX X1, Y1, x2, Y2, 8
Future.BOX X1, Y1, x2, Y2, 7
Future.PRINT X1 + 40, Y1 + 1, " Sell...", 12, -1
FOR X = 1 TO 6
 FOR Y = 1 TO 6
  x2 = X * 36
  Y2 = Y * 36
  item = (Y * 6) - (6 - X)
  IF sellID(item) > 0 THEN
   iconP% = obj(sellID(item)).Icon
   Future.XMSArrayPut x2 + 0, Y2 + 0, icons%, iconP%
    MiniDigit x2, Y2 + 22, STR$(sellAmt(item)), 14
    cost = obj(sellID(item)).cost * (1 + (market! / 100))
    '======================
    IF shopno = 0 THEN cost = cost * .95
    ' 5% decrease in selling price at general store regardless of
    ' market demand (which follows)
    ' This also appears in the final sale area below
    '======================
    cost = cost + INT(cost * -(obj(sellID(isell)).demand / 100))
    MiniDigit x2, Y2 + 29, STR$(cost), 10
  END IF
 NEXT Y
NEXT X

Future.MouseOn
  cost = 0
  DO
   Future.UpdateMouse
   IF Future.MouseB% = 1 THEN
    DO
     Future.UpdateMouse
    LOOP UNTIL Future.MouseB% = 0
    mx% = Future.MouseX%
    my% = Future.MouseY%
    mxs = INT(mx% / 36)
    mys = INT(my% / 36)
    isell = (mys * 6) - (6 - mxs)
    IF isell < 1 OR isell > 36 THEN isell = 0
    IF sellID(isell) > 0 THEN
     available = Possess(sellID(isell))
     MSG "Available:" + STR$(available)
     Amt = VAL(AINPUT$("Amount to sell:", STR$(available)))
     IF Amt > available THEN Amt = available
     cost = obj(sellID(isell)).cost * (1 + (market! / 100)) * Amt
     IF shopno = 0 THEN cost = cost * .95
     cost = cost + INT(cost * -(obj(sellID(isell)).demand / 100))
     IF YesNo%("Sell this " + LTRIM$(RTRIM$(obj(sellID(isell)).oname$)) + " for" + STR$(cost) + "GP?", "Yes", "No") = 1 THEN
      ininv = GetInvNo%(sellID(isell))
    '  invAmt(ininv) = invAmt(ininv) - amt
      obj(sellID(isell)).demand = obj(sellID(isell)).demand + Amt
      ' demand calculate only after an affirmative! not like before
      Give "gold", cost + 0
      sold = sellID(isell)
      IF Possess(invID(ininv)) = 0 THEN
       sellID(isell) = 0
       sellAmt(isell) = 0
      END IF
  
  same = sellID(isell)
  tot = Amt
  FOR i = 1 TO 36
   IF same = invID(i) THEN
    IF invAmt(i) > tot THEN
     tot = tot - Amt
     invAmt(i) = invAmt(i) - Amt
    ELSE
     tot = tot - invAmt(i)
     invAmt(i) = 0
    END IF
    IF invAmt(i) = 0 THEN invID(i) = 0
    IF tot = 0 THEN EXIT FOR
   END IF
  NEXT i
    isell = 0
    RefreshInv
    GOSUB resetSell
   ELSE
    isell = 0
   END IF
     END IF
   END IF
   jkl$ = INKEY$
   SELECT CASE jkl$
    CASE "e"
     ViewEmployed
    CASE CHR$(27)
     EXIT DO
   END SELECT
  LOOP


END SUB

SUB Trade (deal, shopno)
DIM tot AS LONG, Amt AS LONG

 MSG "Would you like to buy something?"
 IF YesNo%("Buy or sell?", "Buy", "Sell") = 1 THEN
  Drawmap currentmap, 1, 0, 0
  MSG "You: Yes thanks"
  'buy
  Buy bought, shopno
 ELSE
 'sell
  Sell sold, shopno
END IF
 Drawmap currentmap, 1, 0, 0
END SUB

SUB ViewEmployed
SelRow = 1
DIM c1 AS LONG, c2 AS LONG
FOR i = 1 TO 20
 IF wContractor(i).BWT.ID > 0 THEN Ncons = Ncons + 1
 IF wEmployee(i).BWT.ID > 0 THEN Nemps = Nemps + 1
NEXT i
IF Nemps = 0 THEN EmpsORcons = 1
rdVEmp:
Future.MouseOff
X1 = 33
Y1 = 16
x2 = 580
Y2 = 328
Future.FILLBOX X1, Y1, x2, Y2, 8
Future.BOX X1, Y1, x2, Y2, 7
Future.PRINT X1 + 40, Y1 + 1, " People Employed by You", 12, -1

 Future.PRINT X1 + 10, Y1 + 15, " Employed                    In Contract", 14, -1
 FOR i = 1 TO 20

   IF EmpsORcons = 1 AND SelRow = i THEN
    c1 = 14: c2 = 0
    Future.PRINT X1 + 225, Y2 - 20, STR$(wContractor(i).BWT.IPW) + " " + RTRIM$(obj(wContractor(i).BWT.MakeID).oname$) + " @" + STR$(wContractor(i).BWT.PayAmt) + " GP p.w.", 12, 0
   ELSE
    c1 = 15: c2 = -1
   END IF
   Future.PRINT X1 + 205, Y1 + 20 + (i * 18), RTRIM$(wContractor(i).Name$) + "  " + RTRIM$(wContractor(i).BWT.TypeN$), c1, c2

   IF EmpsORcons = 0 AND SelRow = i THEN
    c1 = 14: c2 = 0
    'Future.PRINT X1 + 225, Y2 - 20, RTRIM$(obj(wContractor(i).BWT.MakeID).oname$) + STR$(wContractor(i).BWT.PayAmt) + " GP p.w.", 12, 0
   ELSE
    c1 = 15: c2 = -1
   END IF
   Future.PRINT X1 + 25, Y1 + 20 + (i * 18), UCASE$(RTRIM$(wEmployee(i).BWT.TypeN$)), c1, c2
  
'  MiniDigit X1 + 25, Y1 + 20 + (i * 16), UCASE$(RTRIM$(wEmployee(i).BWT.TypeN$)), 14
'  MiniDigit X1 + 215, Y1 + 20 + (i * 16), UCASE$(RTRIM$(wContractor(i).Name$)), 15
 NEXT i

Future.MouseOn
DO
 Future.UpdateMouse
 jkl$ = INKEY$
 SELECT CASE jkl$
  CASE "a"
   i = VAL(AINPUT$("Contractor #:", "1"))
   wContractor(i).Name$ = AINPUT$("Name:", "Halbo Ding" + STR$(INT(RND * 300) + 300))
   wContractor(i).BWT.ID = 1
   wContractor(i).BWT.PayAmt = 3
   wContractor(i).PayID = GetID%("gold")
   wContractor(i).BWT.IPW = 3
   wContractor(i).BWT.MakeID = GetID%(AINPUT$("ID$:", "cpor"))
   GOSUB rdVEmp
  CASE CHR$(0) + "H"
   IF EmpsORcons = 0 THEN
    IF SelRow > 1 THEN SelRow = SelRow - 1 ELSE SelRow = Nemps
   ELSE
    IF SelRow > 1 THEN SelRow = SelRow - 1 ELSE SelRow = Ncons
   END IF
   GOSUB rdVEmp
  CASE CHR$(0) + "P"
   IF EmpsORcons = 0 THEN
    IF SelRow < Nemps THEN SelRow = SelRow + 1 ELSE SelRow = 1
   ELSE
    IF SelRow < Ncons THEN SelRow = SelRow + 1 ELSE SelRow = 1
   END IF
   GOSUB rdVEmp
  CASE CHR$(0) + "K"
   IF EmpsORcons = 0 THEN
    EmpsORcons = 1
    IF SelRow > Ncons THEN SelRow = Ncons
   ELSE
    EmpsORcons = 0
    IF SelRow > Nemps THEN SelRow = Nemps
   END IF
   GOSUB rdVEmp
  CASE CHR$(0) + "M"
   IF EmpsORcons = 0 THEN
    EmpsORcons = 1
    IF SelRow > Ncons THEN SelRow = Ncons
   ELSE
    EmpsORcons = 0
    IF SelRow > Nemps THEN SelRow = Nemps
   END IF
   GOSUB rdVEmp
  CASE CHR$(27)
   EXIT DO
 END SELECT
LOOP
END SUB

SUB WriteQVAR (qvar$, val$)
 file$ = "data\qv.dat"
 file2$ = "data\qv.tmp"
 ff = FREEFILE
 OPEN file$ FOR APPEND AS #ff
 CLOSE #ff
 OPEN file$ FOR INPUT AS #ff
 ff2 = FREEFILE
 OPEN file2$ FOR APPEND AS #ff2
  DO UNTIL EOF(ff)
   INPUT #ff, pname2$, qv$, v$
   IF UCASE$(qv$) = UCASE$(qvar$) AND pname$ = pname2$ THEN
    v$ = val$
    found = 1
   END IF
   WRITE #ff2, pname2$, qv$, v$
  LOOP
  IF found = 0 THEN WRITE #ff2, pname$, qvar$, val$
  CLOSE #ff
  CLOSE #ff2
  KILL file$
  NAME file2$ AS file$
END SUB

