%%HP: T(3)A(D)F(.);
@ by Scotty Thompson
DIR
  HELP
    \<< CLLCD DEPTH 0 \-> dep gn
      \<< 1 CF
        IF dep 0 ==
        THEN "NO OBJECTS ON STACK." 1 SF
        ELSE DUP
          IF TYPE 6 \=/
          THEN "INVALID OBJECT TYPE." 1 SF
          END
        END
        DO 2 CF 4 CF 6 CF
          WHILE 1 FS?C
          REPEAT
            IF 6 FC?C
            THEN "\010\010"
            ELSE "\010"
            END " ENTER GLOBAL NAME:" + + "" INPUT REMSP "'" + "'" SWAP + DUP
            IF "''" ==
            THEN DROP KILL
            END DUP
            IF "'PURGE'" ==
            THEN DROP "0"
              IF 2 FS?
              THEN 2 CF
              ELSE 2 SF
              END 3 SF
            END DUP
            IF "'DEFINE'" ==
            THEN DROP "0"
              IF 4 FS?
              THEN 4 CF
              ELSE 4 SF
              END 5 SF
            END
            IFERR OBJ\->
            THEN DROP 0
            END
            IFERR DUP
            THEN 0 0
            END
            IF TYPE 6 \=/
            THEN DROP
              IF 3 FC? 5 FC? AND
              THEN "INVALID OBJECT TYPE."
              ELSE
                IF 3 FS?C THEN ""
                  IF 4 FS?C
                  THEN DROP 6 SF "DEFINE CANCELED.\010"
                  END
                  IF 2 FS?
                  THEN "PURGE HELP TEXT."
                  ELSE "PURGE CANCELED."
                  END +
                END
                IF 5 FS?C
                THEN ""
                  IF 2 FS?C
                  THEN DROP 6 SF "PURGE CANCELED.\010"
                  END
                  IF 4 FS?
                  THEN "DEFINE HELP TEXT."
                  ELSE "DEFINE CANCELED."
                  END +
                END
              END 1 SF
            END
          END 'gn' STO gn VTYPE 1 + DUP
          IF NOT
          THEN DROP 1 SF
          END "NAME: " gn \->STR +
          IF 4 FS?
          THEN DUP
            IF 1 FS?
            THEN "NO "
            ELSE "DEFINE "
            END SWAP + "\010\010ENTER TEXT \<= 48 CHRS:" + "" INPUT 1 48 SUB
              REMCR DUP
            IF "" ==
            THEN DROP
            ELSE gn \->STR SWAP + 1 CHR +
              IFERR :0: XXXHELP RCL NEWOB
              THEN DROP ""
              END DUP
              IF gn \->STR POS NOT
              THEN SWAP + :0: XXXHELP DUP PURGE STO
              ELSE DROP2
              END
            END
          END
          IF 1 FS?
          THEN "\010TYPE: UNDEFINED \010SIZE: UNDEFINED \010 CRC: UNDEFINED" +
          ELSE SWAP { "REAL" "COMPLEX" "STRING" "REAL ARRAY" "COMPLEX ARRAY"
            "LIST" "GLOBAL NAME" "LOCAL NAME" "PROGRAM" "ALGEBRAIC"
            "BINARY INTEGER" "GRAPHICS OBJECT" "TAGGED OBJECT" "UNIT OBJECT"
            "XLIB NAME" "DIRECTORY" "LIBRARY" "BACKUP OBJECT" "FUNCTION"
            "COMMAND" } SWAP GET "\010TYPE: " SWAP + + "\010SIZE: " gn BYTES
            \->STR SWAP "\010 CRC: " SWAP \->STR + + + +
          END 10 CF "\010TEXT: "
          IFERR :0: XXXHELP RCL NEWOB
          THEN DROP "NONE" 10 SF
          END
          IF 10 FC?C
          THEN DUP gn \->STR POS DUP
            IF NOT
            THEN DROP2 "NONE"
            ELSE
              IF 2 FS?C
              THEN DUP
                IF 1 ==
                THEN DROP DUP 1 CHR POS 1 + SWAP DUP SIZE ROT SWAP SUB
                  :0: XXXHELP DUP PURGE STO "PURGED" END
                ELSE gn \->STR SIZE + SWAP DUP SIZE ROT SWAP SUB DUP 1 CHR POS
                  1 - 1 SWAP SUB 1 48 SUB REMCR DUP 1 16 SUB SWAP DUP 17 32 SUB
                  SWAP 33 48 SUB "\010      " SWAP + + "\010      " SWAP + +
              END
            END
          END + + DUP CLLCD 0 DISP
          DO 0 WAIT DUP
            IF 21.2 ==
            THEN DROP WON "  H E L P" WOFF + + PR1 DROP CR PR1 CR
              " - - - - - - - - - - " PR1 DROP CR CR CR 0
            END
          UNTIL IP 51 ==
          END DROP CLLCD "PRESS ENTER TO END." 1 SF
        UNTIL 0
        END
      \>>
    \>>
  REMCR @ remove carriage returns
    \<< 3 CF
      DO DUP
        IF "\010" POS DUP
        THEN DUP
          IF 1 ==
          THEN DROP DUP SIZE 2 SWAP SUB
          ELSE SWAP DUP 1 4 PICK 1 - SUB SWAP 3 PICK 1 + OVER SIZE SUB + SWAP
            DROP
          END
        ELSE DROP 3 SF
        END
      UNTIL 3 FS?C
      END
    \>>
  REMSP @ remove spaces
    \<< 3 CF
      DO DUP
        IF " " POS DUP
        THEN DUP
          IF 1 ==
          THEN DROP DUP SIZE 2 SWAP SUB
          ELSE SWAP DUP 1 4 PICK 1 - SUB SWAP 3 PICK 1 + OVER SIZE SUB + SWAP
            DROP
          END
        ELSE DROP 3 SF
        END
      UNTIL 3 FS?C
      END
    \>>
  WOFF @ wide off
    \<< 27 CHR 252 CHR +
    \>>
  WON @ wide on
    \<< 27 CHR 253 CHR +
    \>>
END