REM Editcoin v1.5a - editcoin utility for Dndbbs v5.0a r2.0a PD 2022

REM  v1.1a - Adds form$ and overflow check. (09/13/2019)
REM  v1.2a - Adds StatusLine and /p to command line. (09/21/2019)
REM           Also adds editcoin.cfg..
REM  v1.3a - Adds DND.Path to filenames. (10/10/2020)
REM           Also adds /A to use autopack
REM  v1.4a - Adds save.screen. (06/22/2021)
REM  v1.5a - Adds bronze coin type (06/01/2022)

REM Compile VB 1.00
REM   Bc Editcoin/e/o;
REM   Link Editcoin,,,vbdos/e;

' declare subroutines
DECLARE SUB ClearStatusLine ()
DECLARE SUB Pack.Coins (Var1!)
DECLARE SUB Read.Rows (Var%)
DECLARE SUB Save.Screen2 (Var%)
DECLARE SUB StatusLine ()

' declare format functions
DECLARE FUNCTION Form$ (X#)
DECLARE FUNCTION Form2$ (X#)

' declare time functions
DECLARE FUNCTION Timeit! ()
Declare Function Time.Elapsed(S!,W!)

' declare keyboard functions
Declare Function InkeyX$()
DECLARE FUNCTION KeyboardLine$()

Type RegTypeX
 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 InregsX As RegTypeX, OutregsX As RegTypeX
Declare Sub InterruptX(N As Integer,I As RegTypeX,O As RegTypeX)

CONST Version$ = "v1.5a"
CONST Release$ = "r1.0a"

' declare save.screen variable
DIM SHARED Debug AS INTEGER
DIM SHARED Max.Row AS INTEGER

DIM SHARED Filename AS STRING
DIM SHARED Filename2 AS STRING

' savescreen variable
DIM SHARED TempX AS INTEGER

FUNCTION Form$ (Var#)
 Form$ = Format$(Var#, "#,##0;;" + CHR$(34) + "zero" + CHR$(34))
END FUNCTION

FUNCTION Form2$ (Var#)
 Form2$ = Format$(Var#, "#,##0;;")
END FUNCTION

' uses direct keyboard input to get an input line.
FUNCTION KeyboardLine$
 Var$ = ""
 StartTime2# = Timeit!
 DO
    LOCATE ,,1
    Var2$ = Inkey$
    RunTime2# = Timeit! - StartTime2#
    IF RunTime2# < 0# THEN RunTime2# = RunTime2# + 86400#
    IF RunTime2# >= 1# THEN
       StartTime2# = Timeit!
       Var1 = CSRLIN
       Var2 = POS(0)
       CALL StatusLine
       Locate Var1,Var2,1
    END IF
    If Len(Var2$) Then
       Select Case Len(Var2$)
       Case 1
          SELECT CASE Var2$
          CASE CHR$(13) ' return
             EXIT DO
          CASE CHR$(27) ' escape
             FOR V% = LEN(Var$) TO 1 STEP -1
                IF POS(0) > 1 THEN ' check cursor location
                   LOCATE CSRLIN, POS(0) - 1, 0
                   PRINT " ";
                   LOCATE CSRLIN, POS(0) - 1, 1
                ELSE ' line-wrap
                   LOCATE CSRLIN - 1, 80, 0
                   PRINT " ";
                   LOCATE CSRLIN - 1, 80, 1
                END IF
             NEXT   
             Var$ = ""
          CASE CHR$(8) ' backspace
             IF LEN(Var$) > 0 THEN
                Var$ = LEFT$(Var$, LEN(Var$) - 1)
                IF POS(0) > 1 THEN ' check cursor location
                   LOCATE CSRLIN, POS(0) - 1, 0
                   PRINT " ";
                   LOCATE CSRLIN, POS(0) - 1, 1
                ELSE ' line-wrap
                   LOCATE CSRLIN - 1, 80, 0
                   PRINT " ";
                   LOCATE CSRLIN - 1, 80, 1
                END IF
             END IF
          CASE ELSE ' store input
             PRINT Var2$;
             LOCATE , , 1
             Var$ = Var$ + Var2$
          END SELECT
       Case 2
          SELECT CASE Right$(Var2$,1)
          CASE CHR$(83) ' delete
             Debug = Not Debug
          End Select
       End Select
    END IF
 LOOP

 ' return input line
 KeyboardLine$ = Var$
END FUNCTION

' special inkey$ function
Function InkeyX$
 StartTime2# = Timeit!
 Do
    X$ = Inkey$
    If Len(X$) Then
       InkeyX$ = X$
       Exit Function
    Endif
    RunTime2# = Timeit! - StartTime2#
    IF RunTime2# < 0# THEN RunTime2# = RunTime2# + 86400#
    IF RunTime2# >= 1# THEN
       StartTime2# = Timeit!
       Var1 = CSRLIN
       Var2 = POS(0)
       CALL StatusLine
       Locate Var1,Var2,1
    END IF
 Loop
End Function

FUNCTION Timeit!
 REM  Timeit! = Timer ' for bc7 ide
 t1$ = Format$(Now, "hh:mm:ss") ' seconds past midnight
 t1! = CSNG(INT(VAL(MID$(t1$, 1, 2))+.5)) * 3600! + CSNG(INT(VAL(MID$(t1$, 4, 2))+.5)) * 60! + CSNG(INT(VAL(MID$(t1$, 7, 2))))
 Timeit! = t1!
END FUNCTION

Function Time.Elapsed(Start.Time!,Wait.Time!)
  Elapsed.Time!=Timeit!-Start.Time!
  If Elapsed.Time!<False Then
     Elapsed.Time!=Elapsed.Time!+86400!
  Endif
  If Elapsed.Time!>=Wait.Time! Then
     Time.Elapsed=-1
  Else
     Time.Elapsed=False
  Endif
End Function

' assign filenames
DND.Path$ = ENVIRON$("DNDBBS")
IF DND.Path$ <> "" THEN
   IF RIGHT$(DND.Path$, 1) <> "\" THEN
      DND.Path$ = DND.Path$ + "\"
   END IF
END IF

Filename = DND.Path$ + "coins.dat"
Filename2 = DND.Path$ + "coins.bkp"

ON ERROR GOTO ErrResume0
Call Stdin(Var)
' get command line
C$ = COMMAND$
IF LEN(C$) THEN
   SELECT CASE C$
   CASE "/A"
      AutoPack = -1
   CASE "/P"
      CALL Pack.Coins(Var1!)
      COLOR 15
      PRINT "Coins.dat packed."
      COLOR 14
      IF Var1! = 1! THEN PRINT " 1 record packed." ELSE PRINT Var1!; "records packed."
      COLOR 7
      PRINT "Now exiting Editcoin."
      END
   CASE "/?"
      ' boot usage
      COLOR 15
      PRINT "Editcoin utility " + Version$ + " " + Release$
      PRINT "Usage:"
      COLOR 14
      PRINT "  Editcoin [/a]|[/p]"
      COLOR 15
      PRINT "Where:"
      COLOR 14
      PRINT "  /a  autopack."
      PRINT "  /p  pack coins."
      COLOR 7
      END
   CASE ELSE
      COLOR 15
      PRINT "Boot error."
      COLOR 14
      PRINT "  Type Editcoin /? for usage."
      COLOR 7
      END
   END SELECT
END IF

' display statusline
CALL Read.Rows(Max.Row)
CALL Save.Screen2(0)
CLS
CALL StatusLine

' start editcoin
OPEN Filename FOR RANDOM SHARED AS #1 LEN = 16
FIELD #1, 4 AS R1$, 8 AS G1$, 2 AS P1x$, 2 AS P2x$
COLOR 15
PRINT "Editcoin " + Version$ + " " + Release$
COLOR 14

' init coins.dat
IF LOF(1) / 16! = 0! THEN
   LSET R1$ = MKS$(0): LSET G1$ = MKD$(0): LSET P1x$ = MKI$(0): LSET P2x$ = MKI$(0)
   PUT #1, 1
   COLOR 14
   PRINT " Coins.dat initialized."
END IF

' get config setting
F$ = DND.Path$ + "editcoin.cfg"
IF DIR$(F$) <> "" THEN
   CLOSE #2
   OPEN F$ FOR INPUT SHARED AS #2
   DO UNTIL EOF(2)
      LINE INPUT #2, V$
      V$ = LCASE$(V$): V$ = RTRIM$(V$)
      IF LEFT$(V$, 8) = "autopack" THEN
         V$ = MID$(V$, 9): V$ = LTRIM$(V$)
         IF LEFT$(V$, 1) = "=" THEN
            V$ = MID$(V$, 2): V$ = LTRIM$(V$)
            SELECT CASE V$
            CASE "-1", "true", "on"
               AutoPack = -1
            END SELECT
         END IF
      END IF
   LOOP
END IF

IF AutoPack THEN
   CALL Pack.Coins(Var1!)
   COLOR 15
   PRINT "Coins.dat packed."
   ' restart editcoin datafile
   OPEN FileName FOR RANDOM SHARED AS #1 LEN = 16
   FIELD #1, 4 AS R1$, 8 AS G1$, 2 AS P1x$, 2 AS P2x$
END IF

' begin editcoin loop
Checked = 0
ErrExit0:
DO
   COLOR 15
   PRINT "Edit coins:";
   PRINT " (Records:" + STR$(LOF(1) / 16!); ")"
   IF Checked = 0 THEN
      GOSUB Check.Coins
      Checked = -1
   END IF
   COLOR 14
   PRINT " [A]dd record"
   PRINT " [C]hange record"
   PRINT " [D]elete record"
   PRINT " [F]ind coins"
   PRINT " [H]elp list"
   PRINT " [L]ist coins"
   PRINT " [P]ack file"
   PRINT " [S]can file"
   PRINT " [V]erify file"
   PRINT " [Z]scan and count"
   COLOR 15
   PRINT "Enter option(? = Help, Q to Quit)?";
   C$ = ""
   DO
      C$ = INKEYX$
      IF LEN(C$) = 1 THEN
         IF C$ = CHR$(13) THEN C$ = "Q"
         C$ = UCASE$(C$)
         IF C$ >= "A" AND C$ <= "Z" THEN
            PRINT UCASE$(C$)
         ELSE
            PRINT
         END IF
         EXIT DO
      END IF
      IF LEN(C$) = 2 THEN
         IF RIGHT$(C$, 1) = CHR$(83) THEN
            Debug = NOT Debug
         END IF
      END IF
   LOOP
   COLOR 14
   SELECT CASE UCASE$(C$)
   CASE "A"
      LSET R1$ = MKS$(0): LSET G1$ = MKD$(0): LSET P1x$ = MKI$(0): LSET P2x$ = MKI$(0)
      PUT #1, LOF(1) / 16! + 1!
      PRINT "Record added."
      PRINT " Records:" + STR$(LOF(1) / 16!)
   CASE "C"
      V$ = STR$(LOF(1) / 16!): V$ = LTRIM$(V$)
      IF LOF(1) / 16! = 0! THEN
         PRINT "No records found.": V! = 0!
      ELSE
         PRINT "Enter record(1-"; V$; ")? ";
         V!=Int(Val(KeyboardLine$)+.5) : V! = INT(V!)
         print
      END IF
      IF V! >= 1! AND V! <= LOF(1) / 16! THEN
         GET #1, V!
         PRINT "Room? "; : R$=KeyboardLine$
         print
         IF R$ = "" THEN
            R! = CVS(R1$)
         ELSE
            R! = INT(VAL(R$)+.5)
            IF R! < 0! THEN R! = 0!
         END IF
         PRINT "Gold? "; : G$=KeyboardLine$
         print
         IF G$ = "" THEN
            G# = CVD(G1$)
         ELSE
            G# = INT(VAL(G$)+.5)
            IF G# < 0# THEN G# = 0#
         END IF
         PRINT "Hidden(N=No,Y=Yes)"; : C$=KeyboardLine$ : C$ = UCASE$(C$): IF C$ = "Y" THEN C = -1 ELSE C = 0
         print
         PRINT "Type(0=gold,1=silver,2=copper,3=bronze)";
         X=Int(Val(KeyboardLine$)+.5) : X = INT(X): IF X >= 0 AND X <= 3 THEN T = X ELSE T = 0
         print
         Z = 0
         IF T > 0 THEN
            IF G# = 0# THEN
               Strng$ = "Gold must be nonzero."
               Z = -1
            END IF
         END IF
         IF T = 0 THEN ' gold
            IF G# = 0# THEN ' gold divisor
               Strng$ = "Gold must be multiple of 1."
               Z = -1
            END IF
         END IF
         IF T = 1 THEN ' silver
            IF G# > 0# THEN
               IF G# MOD 10# THEN ' silver divisor
                  Strng$ = "Silver must be multiple of 10."
                  Z = -1
               END IF
            END IF
         END IF
         IF T = 2 THEN ' copper
            IF G# > 0# THEN
               IF G# MOD 100# THEN ' copper divisor
                  Strng$ = "Copper must be multiple of 100."
                  Z = -1
               END IF
            END IF
         END IF
         IF T = 3 THEN ' bronze
            IF G# > 0# THEN
               IF G# MOD 1000# THEN ' bronze divisor
                  Strng$ = "Bronze must be multiple of 1000."
                  Z = -1
               END IF
            END IF
         END IF
         IF Z = 0 THEN
            LSET R1$ = MKS$(R!): LSET G1$ = MKD$(G#): LSET P1x$ = MKI$(C): LSET P2x$ = MKI$(T)
            PUT #1, V!
            PRINT "Record"; V!; "changed."
         ELSE
            PRINT "Record error: "; Strng$
         END IF
      END IF
   CASE "D"
      V$ = STR$(LOF(1) / 16!): V$ = LTRIM$(V$)
      IF LOF(1) / 16! = 0! THEN
         PRINT "No records found.": V! = 0!
      ELSE
         PRINT "Enter record(1-"; V$; ")? ";
         V!=Int(Val(KeyboardLine$)+.5): V! = INT(V!)
         print
      END IF
      IF V! >= 1! AND V! <= LOF(1) / 16! THEN
         LSET R1$ = MKS$(0): LSET G1$ = MKD$(0): LSET P1x$ = MKI$(0): LSET P2x$ = MKI$(0)
         PUT #1, V!
         PRINT "Record deleted."
         Checked = 0
      END IF
   CASE "F"
      color 15
      PRINT "Room from? "; : R1!=Int(Val(KeyboardLine$)+.5) : R1! = INT(R1!): IF R1! < 0! THEN R1! = 0!
      print
      PRINT "Room to? "; : R2!=Int(Val(KeyboardLine$)+.5) : R2! = INT(R2!): IF R2! < 0! THEN R2! = 0!
      print
      PRINT "Gold from? "; : G1#=Int(Val(KeyboardLine$)+.5) : G1# = INT(G1#): IF G1# < 0# THEN G1# = 0#
      print
      PRINT "Gold To? "; : G2#=Int(Val(KeyboardLine$)+.5) : G2# = INT(G2#): IF G2# < 0# THEN G2# = 0#
      print
      PRINT "Hidden(N=No,Y=Yes)? "; : C$=KeyboardLine$ : C$ = UCASE$(C$): IF C$ = "Y" THEN C = -1 ELSE C = 0
      print
      PRINT "Type(0=gold,1=silver,2=copper,3=bronze)? "; : X=Int(Val(KeyboardLine$)+.5) : X = INT(X): IF X >= 1 AND X <= 3 THEN T = X ELSE T = 0
      print
      Q = 1
      X = 0
      PRINT "Searching file: ";
      IF R1! > 0! AND R2! > 0! THEN PRINT "Room"; R1!; "-"; R2!; " ";
      IF G1# > 0# AND G2# > 0# THEN PRINT "Gold"; G1#; "-"; G2#; " ";
      IF C THEN PRINT "(hidden) ";
      IF T = 0 THEN PRINT "(gold)";
      IF T THEN IF T = 1 THEN PRINT "(silver)";  ELSE IF T = 2 THEN PRINT "(copper)"; ELSE IF T = 3 THEN PRINT "(bronze)";
      PRINT
      FOR V! = 1! TO LOF(1) / 16!
         GET #1, V!
         Z = 0
         IF R1! > 0! AND R2! > 0! THEN IF CVS(R1$) >= R1! AND CVS(R1$) <= R2! THEN Z = -1
         IF G1# > 0# AND G2# > 0# THEN IF CVD(G1$) >= G1# AND CVD(G1$) <= G2# THEN Z = -1
         IF C THEN IF CVI(P1x$) THEN Z = -1
         IF T THEN IF CVI(P2x$) = T THEN Z = -1
         IF Z THEN
            X = -1
            COLOR 15
            PRINT "Match record:"; V!;
            SELECT CASE CVI(P2x$)
            CASE 0
               PRINT "(gold)";
            CASE 1
               PRINT "(silver)";
            CASE 2
               PRINT "(copper)";
            CASE 3
               PRINT "(bronze)";
            END SELECT
            IF C THEN
               IF CVI(P1x$) THEN
                  PRINT " (hidden)"
               ELSE
                  PRINT
               END IF
            ELSE
               PRINT
            END IF
            Q = Q + 1
            IF Q = 23 THEN
               Q = 0
               COLOR 14
               PRINT "More(y/n)?";
               DO
                  Z$ = INKEYX$: Z$ = UCASE$(Z$)
                  IF Z$ = "N" THEN PRINT : Q = 0: EXIT FOR
                  IF Z$ = CHR$(13) OR Z$ = "Y" THEN PRINT : EXIT DO
               LOOP
            END IF
         END IF
      NEXT
      IF X = 0 THEN
         COLOR 15
         PRINT "No matching records found."
         Q = -1
      END IF
      IF Q THEN
         COLOR 14
         PRINT "More(y/n)?";
         WHILE INKEYX$ = "": WEND: PRINT
      END IF
   CASE "L"
      IF LOF(1) / 16! = 0! THEN
         PRINT "No records found.": Z1! = 0!: Z2! = 0!
      ELSE
         color 15
         V$ = "From 1-" + MID$(STR$(LOF(1) / 16!), 2) + "? "
         PRINT V$; : Z1!=Int(Val(KeyboardLine$)+.5) : Z1! = INT(Z1!): IF Z1! = 0! THEN Z1! = 1!
         print
         IF Z1! < 1! OR Z1! > LOF(1) / 16! THEN Z1! = 0!
         V$ = "To 1-" + MID$(STR$(LOF(1) / 16!), 2) + "? "
         PRINT V$; : Z2!=Int(Val(KeyboardLine$)+.5) : Z2! = INT(Z2!): IF Z2! = 0! THEN Z2! = LOF(1) / 16!
         print
         IF Z2! < 1! OR Z2! > LOF(1) / 16! THEN Z2! = 0!
         IF Z1! > Z2! THEN Z1! = 0!: Z2! = 0!
      END IF
      IF Z1! > 0! AND Z2! > 0! THEN
         FOR V! = Z1! TO Z2!
            GET #1, V!
            COLOR 15
            PRINT "Record:"; STR$(V!)
            GET #1, V!
            COLOR 14
            PRINT " Room: "; Form2$(CDBL(CVS(R1$)))
            PRINT " Gold:";
            IF INSTR(STR$(CVD(G1$)), "D") THEN
               PRINT STR$(CVD(G1$))
            ELSE
               PRINT " "; Form$(CVD(G1$))
            END IF
            PRINT " Hidden: ";
            IF CVI(P1x$) THEN PRINT "Yes" ELSE PRINT "No"
            PRINT " Type: "; : X = CVI(P2x$)
            SELECT CASE X
            CASE 0
               PRINT "Gold"
            CASE 1
               PRINT "Silver"
            CASE 2
               PRINT "Copper"
            CASE 3
               PRINT "Bronze"
            CASE ELSE
               PRINT "<n/a>"
            END SELECT
            COLOR 15
            PRINT "More(y/n)?";
            DO
               C$ = INKEYX$
               C$ = UCASE$(C$)
               IF C$ = "N" THEN PRINT : EXIT FOR
               IF C$ = CHR$(13) OR C$ = "Y" THEN PRINT : EXIT DO
            LOOP
         NEXT
      END IF
   CASE "P"
      CALL Pack.Coins(Var1!)
      ' restart editcoin datafile
      OPEN Filename FOR RANDOM SHARED AS #1 LEN = 16
      FIELD #1, 4 AS R1$, 8 AS G1$, 2 AS P1x$, 2 AS P2x$
      PRINT "Coins.dat packed."
      IF Var1! = 1! THEN PRINT " 1 record packed." ELSE PRINT Var1!; "records packed."
   CASE "S"
      PRINT "Scanning file.."
      Q = 1
      Z! = 0!
      FOR V! = 1! TO LOF(1) / 16!
         GET #1, V!
         R! = CVS(R1$)
         IF R! < 0! OR R! <> INT(R!) THEN
            PRINT "Error in record:"; V!; "(bad room number)"
            Z! = Z! + 1!
            Q = Q + 1
         END IF
         G# = CVD(G1$)
         IF G# < 0# OR G# <> INT(G#) THEN
            PRINT "Error in record:"; V!; "(bad gold amount)"
            Z! = Z! + 1!
            Q = Q + 1
         END IF
         X = CVI(P2x$)
         IF X < 0 OR X > 3 OR X <> INT(X) THEN
            PRINT "Error in record:"; V!; "(bad cointype)"
            Z! = Z! + 1!
            Q = Q + 1
         END IF
         IF X = 1 THEN ' silver
            IF G# > 0# THEN
               IF G# MOD 10# THEN
                  PRINT "Error in record:"; V!; "(bad silver modulo)"
                  Z! = Z! + 1!
                  Q = Q + 1
               END IF
            END IF
         END IF
         IF X = 2 THEN ' copper
            IF G# > 0# THEN
               IF G# MOD 100# THEN
                  PRINT "Error in record:"; V!; "(bad copper modulo)"
                  Z! = Z! + 1!
                  Q = Q + 1
               END IF
            END IF
         END IF
         IF X = 3 THEN ' bronze
            IF G# > 0# THEN
               IF G# MOD 1000# THEN
                  PRINT "Error in record:"; V!; "(bad bronze modulo)"
                  Z! = Z! + 1!
                  Q = Q + 1
               END IF
            END IF
         END IF
         IF Q = 23 THEN
            Q = 0
            COLOR 14
            PRINT "More(y/n)?";
            DO
               Z$ = INKEYX$: Z$ = UCASE$(Z$)
               IF Z$ = "N" THEN PRINT : Q = 0: EXIT FOR
               IF Z$ = CHR$(13) OR Z$ = "Y" THEN PRINT : EXIT DO
            LOOP
         END IF
      NEXT
      IF Z! = 0! THEN PRINT "No errors found."
      IF Z! > 0! THEN
         IF Z! = 1! THEN PRINT " 1 error found." ELSE PRINT Z!; "errors found."
         PRINT "Verify file suggested."
      END IF
   CASE "V"
      PRINT "Verifying file.."
      Z! = 0!
      Z2! = 0!
      FOR V! = 1! TO LOF(1) / 16!
         GET #1, V!
         F = 0
         R! = CVS(R1$)
         IF R! < 0! OR R! <> INT(R!) THEN
            LSET R1$ = MKS$(0)
            Z! = Z! + 1!
            F = -1
         END IF
         G# = CVD(G1$)
         IF G# < 0# OR G# <> INT(G#) THEN
            LSET G1$ = MKD$(0#)
            Z! = Z! + 1!
            F = -1
         END IF
         X = CVI(P2x$)
         IF X < 0 OR X > 3 OR X <> INT(X) THEN
            LSET P2x$ = MKI$(0)
            Z! = Z! + 1!
            F = -1
         END IF
         IF X = 1 THEN ' silver
            IF G# > 0# THEN
               IF G# MOD 10# THEN
                  LSET G1$ = MKD$(0#)
                  F = -1
                  Z! = Z! + 1!
               END IF
            END IF
         END IF
         IF X = 2 THEN ' copper
            IF G# > 0# THEN
               IF G# MOD 100# THEN
                  LSET G1$ = MKD$(0#)
                  Z! = Z! + 1!
                  F = -1
               END IF
            END IF
         END IF
         IF X = 3 THEN ' bronze
            IF G# > 0# THEN
               IF G# MOD 1000# THEN
                  LSET G1$ = MKD$(0#)
                  Z! = Z! + 1!
                  F = -1
               END IF
            END IF
         END IF
         PUT #1, V!
         IF F THEN Z2! = Z2! + 1!
      NEXT
      IF Z! = 0! THEN PRINT "No errors in any records found."
      IF Z! > 0! THEN
         IF Z! = 1! THEN
            IF Z2! = 1! THEN
               PRINT Z!; "error in"; Z2!; "record corrected."
            ELSE
               PRINT Z!; "error in"; Z2!; "records corrected."
            END IF
         ELSE
            IF Z2! = 1! THEN
               PRINT Z!; "errors in"; Z2!; "record corrected."
            ELSE
               PRINT Z!; "errors in"; Z2!; "records corrected."
            END IF
         END IF
      END IF
   CASE "H", "?"
      COLOR 15
      PRINT "Editcoin Menu:"
      PRINT
      PRINT "   [A]dd record"
      PRINT
      PRINT "     Adds a blank record to end of file."
      PRINT
      PRINT "   [C]hange record"
      PRINT
      PRINT "     Prompt for record number then edits Room, Gold, Hidden, and Cointype."
      PRINT "       Where cointype is: 0=Gold, 1=Silver, 2=Copper, 3=bronze."
      PRINT
      PRINT "   [D]elete record"
      PRINT
      PRINT "     Prompt for record number then resets all values to nul."
      PRINT
      PRINT "   [F]ind coins"
      PRINT
      PRINT "     Searchs the datafile for specific Room/Gold/Hidden/Type."
      PRINT
      PRINT "   [L]ist coins"
      PRINT
      PRINT "     Lists records and values prompting for more."
      COLOR 14
      PRINT "-More-";
      DO
         Z$ = INKEYX$: Z$ = UCASE$(Z$)
         IF LEN(Z$) THEN PRINT : EXIT DO
      LOOP
      COLOR 15
      PRINT "   [P]ack file"
      PRINT
      PRINT "     Copies coins.dat file and rewrites skipping empty records."
      PRINT
      PRINT "   [S]can file"
      PRINT
      PRINT "     Scans the datafile for invalid records."
      PRINT
      PRINT "   [V]erify file"
      PRINT
      PRINT "     Scans the datafile and attempts to correct errors."
      PRINT
      PRINT "   [Z]scan and count"
      PRINT
      PRINT "     Similar to find only displays number of records found."
      COLOR 14
      PRINT "-More-";
      DO
         Z$ = INKEYX$: Z$ = UCASE$(Z$)
         IF LEN(Z$) THEN PRINT : EXIT DO
      LOOP
   CASE "Z"
      color 15
      PRINT "Room from? "; : R1!=Int(Val(KeyboardLine$)+.5) : R1! = INT(R1!): IF R1! < 0! THEN R1! = 0!
      print
      PRINT "Room to? "; : R2!=Int(Val(KeyboardLine$)+.5) : R2! = INT(R2!): IF R2! < 0! THEN R2! = 0!
      print
      PRINT "Gold from? "; : G1#=Int(Val(KeyboardLine$)+.5) : G1# = INT(G1#): IF G1# < 0# THEN G1# = 0#
      print
      PRINT "Gold To? "; : G2#=Int(Val(KeyboardLine$)+.5) : G2# = INT(G2#): IF G2# < 0# THEN G2# = 0#
      print
      PRINT "Hidden(N=No,Y=Yes)? "; : C$=KeyboardLine$ : C$ = UCASE$(C$): IF C$ = "Y" THEN C = -1 ELSE C = 0
      print
      PRINT "Type(0=gold,1=silver,2=copper,3=bronze)? "; : X=Int(Val(KeyboardLine$)+.5) : X = INT(X): IF X >= 1 AND X <= 3 THEN T = X ELSE T = 0
      print
      X! = 0!
      PRINT "Searching file: ";
      IF R1! > 0! AND R2! > 0! THEN PRINT "Room"; R1!; "-"; R2!; " ";
      IF G1# > 0# AND G2# > 0# THEN PRINT "Gold"; G1#; "-"; G2#; " ";
      IF C THEN PRINT "(hidden) ";
      IF T = 0 THEN PRINT "(gold)";
      IF T THEN IF T = 1 THEN PRINT "(silver)";  ELSE IF T = 2 THEN PRINT "(copper)"; ELSE IF T = 3 THEN PRINT "(bronze)";
      PRINT
      FOR V! = 1! TO LOF(1) / 16!
         GET #1, V!
         Z = 0
         IF R1! > 0! AND R2! > 0! THEN IF CVS(R1$) >= R1! AND CVS(R1$) <= R2! THEN Z = -1
         IF G1# > 0# AND G2# > 0# THEN IF CVD(G1$) >= G1# AND CVD(G1$) <= G2# THEN Z = -1
         IF C THEN IF CVI(P1x$) THEN Z = -1
         IF T THEN IF CVI(P2x$) = T THEN Z = -1
         IF Z THEN
            X! = X! + 1!
         END IF
      NEXT
      IF X! = 0! THEN
         COLOR 15
         PRINT "No matching records found."
      END IF
      IF X! > 0! THEN
         IF X! = 1! THEN
            COLOR 15
            PRINT X!; "matching record found."
         ELSE
            COLOR 15
            PRINT X!; "matching records found."
         END IF
      END IF
   CASE "Q"
      PRINT "Exit program(y/n)?";
      DO
         C$ = INKEYX$
         C$ = UCASE$(C$)
         IF C$ = "N" THEN PRINT "N": EXIT DO
         IF C$ = "Y" THEN PRINT "Y": GOTO ExitLoop
      LOOP
   END SELECT
LOOP

' remove statusline and exit.
ExitLoop:
CALL ClearStatusLine
ExitLoop2:
END
1200

' display any errors and resume.
ErrResume0:
 Error.Num = ERR
 COLOR 10, 0
 SELECT CASE Error.Num
 CASE 5 ' should not happen
    PRINT "Syntax error."
    RESUME ErrExit0
 CASE 6 ' can happen with gold
    PRINT "Overflow."
    RESUME ErrExit0
 CASE ELSE
    PRINT "Error"; STR$(Error.Num); "."
 END SELECT
 RESUME ExitLoop2
 END
1300

' only display pack required once..
Check.Coins:
 Var1! = 0!
 FOR V! = 1! TO LOF(1) / 16!
    GET #1, V!
    IF CVS(R1$) = 0! THEN
       Var1! = Var1! + 1!
    END IF
 NEXT
 IF Var1! THEN
    COLOR 10
    PRINT "Pack required! ";
    Var1$ = MID$(STR$(Var1!), 2)
    IF Var1! = 1! THEN
       PRINT "("; Var1$; " empty record found)"
    ELSE
       PRINT "("; Var1$; " empty records found)"
    END IF
 END IF
 RETURN

SUB ClearStatusLine
COLOR 7, 0
CLS
CALL Save.Screen2(-1)
IF TempX = 0 THEN TempX = 1
LOCATE TempX, 1, 1
PRINT
COLOR 15, 0
PRINT "Now exiting Editcoin."
COLOR 7, 0
END
END SUB

SUB Pack.Coins (Var1!)
 ON LOCAL ERROR GOTO ErrResume1
 Var1! = 0!
 CLOSE #1
 OPEN Filename FOR RANDOM SHARED AS #1 LEN = 16
 FIELD #1, 4 AS R1$, 8 AS G1$, 2 AS P1x$, 2 AS P2x$
 IF LOF(1) = 0 THEN EXIT SUB
 CLOSE #2
 IF DIR$(Filename2) <> "" THEN KILL Filename2
 OPEN Filename2 FOR RANDOM SHARED AS #2 LEN = 16
 FIELD #2, 4 AS R2$, 8 AS G2$, 2 AS P1y$, 2 AS P2y$
 FOR V! = 1! TO LOF(1) / 16!
    GET #1, V!
    IF CVS(R1$) > 0! THEN
       LSET R2$ = R1$: LSET G2$ = G1$: LSET P1y$ = P1x$: LSET P2y$ = P2x$
       X! = LOF(2) / 16! + 1!: PUT 2, X!
    ELSE
       Var1! = Var1! + 1!
    END IF
 NEXT
 CLOSE 1, 2
 ' copy backup file to coins.dat file
 KILL Filename: NAME Filename2 AS Filename
 EXIT SUB
ErrExit1:
 CLOSE 1, 2
 EXIT SUB
ErrResume1:
 Error.Num = ERR
 COLOR 10, 0
 PRINT "Error" + STR$(Error.Num) + ": Pack.Coins"
 RESUME ErrExit1
END SUB

SUB Read.Rows (Var%)
 ON LOCAL ERROR GOTO Error.Trap62x
 Temp1 = 50
 LOCATE 50, 1, 0
 Var% = 50
 EXIT SUB
Next.Trap1:
 Temp1 = 43
 LOCATE 43, 1, 0
 Var% = 43
 EXIT SUB
Next.Trap2:
 Var% = 25
 EXIT SUB
Error.Resume62x:
 Var% = 25
 EXIT SUB
Error.Trap62x:
 IF Temp1 = 50 THEN
    RESUME Next.Trap1
 END IF
 IF Temp1 = 43 THEN
    RESUME Next.Trap2
 END IF
 RESUME Error.Resume62x
END SUB

SUB Save.Screen2 (Var%)
 ON LOCAL ERROR GOTO Error.Trap62
 STATIC Temp.ArrayY() AS INTEGER
 STATIC Temp.ArrayZ() AS INTEGER
 IF Var% = False THEN
    VarX3 = (Max.Row - 1) * 80 + 80
    REDIM Temp.ArrayY(VarX3) AS INTEGER
    REDIM Temp.ArrayZ(VarX3) AS INTEGER
    FOR Var1 = 1 TO Max.Row
       FOR Var2 = 1 TO 80
          TempZ1 = SCREEN(Var1, Var2)
          TempZ2 = SCREEN(Var1, Var2, 1)
          VarX2 = (Var1 - 1) * 80 + Var2
          Temp.ArrayY(VarX2) = TempZ1' char
          Temp.ArrayZ(VarX2) = TempZ2' color
       NEXT
    NEXT
 ELSE
    CLS
    FOR VarX = Max.Row TO 1 STEP -1
       FOR VarY = 1 TO 80
          VarX2 = (VarX - 1) * 80 + VarY
          IF Temp.ArrayY(VarX2) <> 32 THEN
             GOTO Next.Line
          END IF
       NEXT
    NEXT
Next.Line:
    TempX = VarX
    FOR Var1 = 1 TO VarX ' Max.Row
       FOR Var2 = 1 TO 80
          VarX2 = (Var1 - 1) * 80 + Var2
          VarB = INT(Temp.ArrayZ(VarX2) / 16)
          VarF = Temp.ArrayZ(VarX2) MOD 16
          TempZ1 = Temp.ArrayY(VarX2)
          LOCATE Var1, Var2, 0
          COLOR VarF, VarB
          PRINT CHR$(TempZ1);
       NEXT
    NEXT
 END IF
Error.Resume62:
 EXIT SUB
Error.Trap62:
 RESUME Error.Resume62
END SUB

SUB StatusLine
LOCATE Max.Row, 1, 1
COLOR 15, 1
S$ = Version$ + " " + Release$ + " > time: " + Format$(Now, "mm-dd-yyyy") + " " + Format$(Now, "hh:mm:ss")
IF Debug THEN
   Var2# = FRE(-1) + FRE("A") ' far+near segments
   Var2$ = Format$(Var2#, "#,##0.00;;")
   S$ = "- Free RAM: " + Var2$ + " bytes."
END IF
S$ = "Editcoin utility " + S$
S$ = LEFT$(S$, 80)
S$ = S$ + SPACE$(80 - LEN(S$))
PRINT S$;
LOCATE Max.Row - 1, 1, 1
COLOR 15, 0
END SUB

Sub Stdin(Var)
 Var=0
 ' check stdin length
 InregsX.AX = &H4202 ' eof
 InregsX.BX = 0 ' stdin
 InregsX.CX = 0
 InregsX.DX = 0
 CALL InterruptX(&H21, InregsX, OutregsX)
 IF OutregsX.AX = 0 THEN ' no input found
     EXIT SUB
 END IF
 Print "Illegal standard input attempted."
 END
End Sub
