REM Editcoin v1.4a - editcoin utility for Dndbbs v5.0a r2.0a PD 2021

' 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#)

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 Compile VB 1.00
REM   Bc Editcoin/e/o;
REM   Link Editcoin/e;

CONST Version$ = "v1.4a"
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

' 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

' 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$ = INKEY$
      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
            CALL StatusLine
         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$; ")";
         INPUT V!: V! = INT(V!)
      END IF
      IF V! >= 1! AND V! <= LOF(1) / 16! THEN
         GET #1, V!
         PRINT "Room"; : INPUT R$
         IF R$ = "" THEN
            R! = CVS(R1$)
         ELSE
            R! = INT(VAL(R$))
            IF R! < 0! THEN R! = 0!
         END IF
         PRINT "Gold"; : INPUT G$
         IF G$ = "" THEN
            G# = CVD(G1$)
         ELSE
            G# = INT(VAL(G$))
            IF G# < 0# THEN G# = 0#
         END IF
         PRINT "Hidden(Y=Yes)"; : INPUT C$: C$ = UCASE$(C$): IF C$ = "Y" THEN C = -1 ELSE C = 0
         PRINT "Type(0=gold,1=silver,2=copper)";
         INPUT X: X = INT(X): IF X >= 0 AND X <= 2 THEN T = X ELSE T = 0
         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 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$; ")";
         INPUT V!: V! = INT(V!)
      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"
      PRINT "Room from"; : INPUT R1!: R1! = INT(R1!): IF R1! < 0! THEN R1! = 0!
      PRINT "Room to"; : INPUT R2!: R2! = INT(R2!): IF R2! < 0! THEN R2! = 0!
      PRINT "Gold from"; : INPUT G1#: G1# = INT(G1#): IF G1# < 0# THEN G1# = 0#
      PRINT "Gold To"; : INPUT G2#: G2# = INT(G2#): IF G2# < 0# THEN G2# = 0#
      PRINT "Hidden(Y=Yes)"; : INPUT C$: C$ = UCASE$(C$): IF C$ = "Y" THEN C = -1 ELSE C = 0
      PRINT "Type(1=silver,2=copper)"; : INPUT X: X = INT(X): IF X >= 1 AND X <= 2 THEN T = X ELSE T = 0
      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 THEN IF T = 1 THEN PRINT "(silver)";  ELSE IF T = 2 THEN PRINT "(copper)";
      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)";
            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$ = INKEY$: 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 INKEY$ = "": WEND: PRINT
      END IF
   CASE "L"
      IF LOF(1) / 16! = 0! THEN
         PRINT "No records found.": Z1! = 0!: Z2! = 0!
      ELSE
         V$ = "From 1-" + MID$(STR$(LOF(1) / 16!), 2)
         PRINT V$; : INPUT Z1!: Z1! = INT(Z1!): IF Z1! = 0! THEN Z1! = 1!
         IF Z1! < 1! OR Z1! > LOF(1) / 16! THEN Z1! = 0!
         V$ = "To 1-" + MID$(STR$(LOF(1) / 16!), 2)
         PRINT V$; : INPUT Z2!: Z2! = INT(Z2!): IF Z2! = 0! THEN Z2! = LOF(1) / 16!
         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 ELSE
               PRINT "<n/a>"
            END SELECT
            COLOR 15
            PRINT "More(y/n)?";
            DO
               C$ = INKEY$
               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 > 2 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 Q = 23 THEN
            Q = 0
            COLOR 14
            PRINT "More(y/n)?";
            DO
               Z$ = INKEY$: 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 > 2 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
         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."
      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$ = INKEY$: 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$ = INKEY$: Z$ = UCASE$(Z$)
         IF LEN(Z$) THEN PRINT : EXIT DO
      LOOP
   CASE "Z"
      PRINT "Room from"; : INPUT R1!: R1! = INT(R1!): IF R1! < 0! THEN R1! = 0!
      PRINT "Room to"; : INPUT R2!: R2! = INT(R2!): IF R2! < 0! THEN R2! = 0!
      PRINT "Gold from"; : INPUT G1#: G1# = INT(G1#): IF G1# < 0# THEN G1# = 0#
      PRINT "Gold To"; : INPUT G2#: G2# = INT(G2#): IF G2# < 0# THEN G2# = 0#
      PRINT "Hidden(Y=Yes)"; : INPUT C$: C$ = UCASE$(C$): IF C$ = "Y" THEN C = -1 ELSE C = 0
      PRINT "Type(1=silver,2=copper)"; : INPUT X: X = INT(X): IF X >= 1 AND X <= 2 THEN T = X ELSE T = 0
      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 THEN IF T = 1 THEN PRINT "(silver)";  ELSE IF T = 2 THEN PRINT "(copper)";
      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$ = INKEY$
         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

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

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

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$ + " " + 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$ = S$ + SPACE$(80 - LEN(S$))
PRINT S$;
LOCATE Max.Row - 1, 1, 1
COLOR 15, 0
END SUB
