%%HP: T(3)A(D)F(.);
@ Version 1.1
@ Copyright 1990 Ross Barnes
DIR
  XQDB
    \<< RCLMENU \-> m
      \<< :0: { DB INIT.0 } EVAL { USE FIND EDIT ADD DEL EXIT } \-> m1
        \<<
          DO m1 TMENU :0: { DB VU.0 } EVAL -1 WAIT \-> k
            \<<
              CASE
                k 25.1 SAME
                THEN DBINFO 2 GET 1 - :0: { DB MOV.0 } EVAL 0
                END k 25.3 SAME
                THEN 1 :0: { DB MOV.0 } EVAL 0
                END k 35.1 SAME
                THEN DBINFO 2 GET 1 + :0: { DB MOV.0 } EVAL 0
                END k 35.3 SAME
                THEN MAXR \->NUM :0: { DB MOV.0 } EVAL 0
                END k 51.1 SAME
                THEN DBINFO OBJ\-> DROP2 GET 0
                END k 11.1 SAME
                THEN :0: { DB USE.0 } EVAL 0
                END k 11.2 SAME
                THEN :0: { DB NUDB } EVAL 1 "" 3 \->LIST 'DBINFO' STO 0
                END k 12.1 SAME
                THEN :0: { DB FND.0 } EVAL 0
                END k 13.1 SAME
                THEN :0: { DB EDT.0 } EVAL 0
                END k 14.1 SAME
                THEN :0: { DB ADD.0 } EVAL 0
                END k 15.1 SAME
                THEN :0: { DB DEL.0 } EVAL 0
                END k 16.1 SAME
                THEN -1
                END 0
              END
            \>>
          UNTIL
          END
        \>> m MENU
      \>>
    \>>
  DEL.0
    \<< "Yy" "Delete record?" { "N" \Ga } INPUT POS
      IF
      THEN DBINFO OBJ\-> DROP2 \-> db recno
        \<<
          IF recno 1 >
          THEN db RCL 1 recno 1 - SUB db RCL recno 1 + MAXR \->NUM SUB + db STO
          END recno 1 - :0: { DB MOV.0 } EVAL
        \>>
      END
    \>>
  INIT.0
    \<<
      IF VARS 'DBINFO' POS
      THEN
        IF DBINFO SIZE 3 ==
        THEN
         IF DBINFO \-> d
          \<< d       TYPE 5 \=/
              d 1 GET TYPE 6 \=/ OR
              d 3 GET TYPE 2 \=/ OR
              d 2 GET TYPE 0 \=/ OR
          \>>
         THEN "DBINFO is invalid" KILL
         END
      ELSE
       "DBINFO is invalid"
        KILL
      END
      ELSE { "" 1 "" } 'DBINFO' STO :0: { DB USE.0 } EVAL
      END
    \>>
  NUDB
    \<< "New database name?" { ".DB" 1 \Ga } INPUT OBJ\-> "Number of fields?"
        { "" \Ga } INPUT OBJ\-> \-> n
      \<< 1 n
        FOR i "FLD" i \->STR +
        NEXT n \->LIST 1 \->LIST OVER STO
      \>>
    \>>
  EDT.0
    \<< DBINFO OBJ\-> DROP2 OVER 1 GET \-> db recno flds
      \<< 1 flds SIZE
        FOR i flds i GET "?" + db recno GET i GET '\Ga' 2 \->LIST INPUT
        NEXT flds SIZE \->LIST db recno ROT PUT
      \>>
    \>>
  VU.0
    \<< DBINFO OBJ\-> DROP2 GET \-> rec
      \<< 3 7
        FOR i "" i DISP
        NEXT 1 rec SIZE 7 MIN
        FOR i rec i GET i 2 + DISP
        NEXT
      \>>
    \>>
  USE.1
    \<< { } VARS \-> vl
      \<< 1 vl SIZE
        FOR i vl i GET DUP \->STR ".DB" POS
          IF
          THEN +
          ELSE DROP
          END
        NEXT
      \>>
    \>>
  USE.0
    \<< :0: { DB USE.1 } EVAL DUP TMENU
      IF SIZE
      THEN "What database?" DBINFO 1 GET \->STR 2 OVER SIZE 1 - SUB 1 \->LIST
        INPUT "'" SWAP OVER + + OBJ\->
      ELSE :0: { DB NUDB } EVAL
      END 1 "" 3 \->LIST 'DBINFO' STO
    \>>
  ADD.0
    \<< DBINFO 1 GET DUP 1 GET SIZE { } 1 ROT
      START { "" } +
      NEXT 1 \->LIST STO+ MAXR \->NUM :0: { DB MOV.0 } EVAL :0: { DB EDT.0 }
      EVAL
    \>>
  MOV.0
    \<< 'DBINFO' SWAP OVER 1 GET RCL SIZE MIN 1 MAX 2 SWAP PUT
    \>>
  FND.0
    \<< DBINFO OBJ\-> DROP '\Ga' 2 \->LIST "Find what?" SWAP INPUT 'DBINFO' OVER
        3 SWAP PUT 3 ROLLD 1 + OVER RCL SIZE MIN ROT :0: { DB FND.1 } EVAL DUP
      IF
      THEN 'DBINFO' 2 ROT PUT
      ELSE DROP
      END
    \>>
  FND.1
    \<< \-> fs
      \<<
        DO \-> i
          \<< i GETI \->STR fs POS
            IF
            THEN DROP2 i 1
            ELSE DUP 1 ==
              IF
              THEN DROP2 0 1
              ELSE 0
              END
            END
          \>>
        UNTIL
        END
      \>>
    \>>
END