; Disk menu system - 3/29/07 WTN
; This is tricky stuff! The design of HP-IPL/OS XDOS etc always assumed
; that IPL code would being done from the prompt, it's redirected into
; the raw console as if the user was typing it. Trying to load, run,
; forget then return to the menu was never considered but as usual a way
; to trick the system was found after much head scratching. Essentially...
; RCONTROL - controls how the new CONSOLE behaves.
; CONSOLE - if RCONTROL is 0 then does normal CONSOLE, otherwise uses
; string on X stack to run the word, forgets it, then reruns DMENU.
; This causes a duplicate CONSOLE but I don't care, that's allowed.
; DMENU - lists files beginning with # (text) and $ (ipl) in menu form
; without the prefixes. # files are displayed with XSHOW, $ files are
; loaded, ran and forgotten and the menu is redisplayed. For $ files
; the string afterwards must be the same as the word name to run,
; which must also be the first word of the package or stuff won't
; get deleted. See further comments below.
; Despite the complexity, this is only uses less than 350 (dec) words.
; Also included...
; !MENU - the main menu from the combo1 system, last mod 3/30/07
;
OCTAL
VARIABLE RCONTROL
RCONTROL #0 PUT
; if RCONTROL is 0 then does a normal CONSOLE and nothing else.
; if RCONTROL is not 0, then name of word to run and forget is
; expected to be on the X stack, executes it then forgets it.
; if a word named DMENU exists it is run after forgetting.
DEFINE CONSOLE
CONSOLE ;execute existing console to reset console/ms redirection
RCONTROL GET IFNZ ;if RCONTROL is not zero
 RCONTROL #0 PUT ;reset it
 $DUP $DEFADR DUP IFZ ;if string is not a valid word
  "RUN ERROR" $PRINT $DROP DROP ;display error and clean up
 ELSE
  EXECUTE ;execute word address still on stack - program runs
  $DEFADR DUP IFZ ;if string is not valid (program error)
   "FORGET ERROR" $PRINT DROP ;display error and clean up
  ELSE
   4 SUB #0 PUT ;put a zero 4 locations before address, forgetting it
   "DMENU" $DEFADR DUP IFZ DROP ELSE EXECUTE ENDIF ;rerun DMENU if it exists
  ENDIF
 ENDIF
ENDIF
END
; disk menu - scans directory for files with names beginning
; with # or $ and adds them to a menu. Files beginning with # are
; displayed using XSHOW, files beginning with $ are loaded, executed and
; removed. The name after $ must be the name of the first word defined
; and also the word that must be run to start the application. Combine
; multiple-word apps into one word if necessary, or use something like
; "NAME" $DEFADR EXECUTE to execute following words so the main word
; can be defined first.
DEFINE DMENU
RCONTROL #0 PUT ;clear failed loads after page errors
DO ;until user exits menu
 #0 ;master exit flag
 CRLF CRLF "=== Disk File Menu ===" $PRINT CRLF
 @BLK GET DUP 1777 ADD +DO INDEX 15 PUT +LOOP ;fill block 0 with CR
 #0 OUTBLOCK ;redirect MS to block #0
 >MS XDIR ;redirect console out to MS then fill block(s) with disk dir
 CONSOLE ;reset console and MS redirection
 #0 INBLOCK ;redirect MS input from block #0
 101 ;letter counter, ascii for "A"
 DO ;while stuff to do
  MS$IN ;get a line from dir listing
  $LEN ;push length (leave on stack for WHILE)
  DUP IFNZ ;if line not empty
   $HEAD ;remove 1st char and push value to stack
   CASE
   = 43 ;if a # then it's text, list it
     SWAP DUP PCHR ") " $PRINT ;print choice
     INC SWAP ;increment letter counter
     #0 17 $SLICE $TRIM $PRINT CRLF ;print the name
   = 44 ;if a $ then it's an app, list it
     SWAP DUP PCHR ") " $PRINT ;print choice
     INC SWAP ;increment letter counter
     #0 17 $SLICE $TRIM $PRINT CRLF ;print the name
     ;ok a bit of duplication but may want to list differently later
   ENDCASE
  ENDIF
  $DROP ;drop the dir line string 
 WHILE
 ;last letter code + 1 on stack
 CONSOLE ;reset console and MS redirection
 ;now have to get user input, find that dir line, figure out
 ;if text or ipl, if text XSHOW it, if program use RCONTROL to run it
 DUP 101 SUB IFZ "Nothing to do" $PRINT DROP ELSE
  "X) Exit disk menu" $PRINT CRLF
  "Press a key: " $PRINT
  DO ;until valid key
   CHRIN ;get a key
   DUP CASE
   = 130 ;if an X
     CRLF ;for consistent spacing
     2 RUN ;restart system, rerunning autostart words
   > 100 ;if at least an A
     OVER ;push last code + 1
     OVER ;push code just pressed
     SWAP SUB IF<0 ;if code < last + 1 it's valid
      CRLF ;for neatness
      #0 INBLOCK ;redirect MS from block 0
      ;stack = master exit, last code + 1, selected code
      101 ;push starting code
      DO ;until selected dir line found
       MS$IN ;get dir line
       #0 20 $SLICE $TRIM $SWAP $DROP ;turn into just filename
       #0 $GET CASE ;action depends on 1st char
       = 43 ;if text file
       OVER OVER SUB IFZ ;if the selected file
        XSHOW ;display that file
        #1 ;don't loop for more
       ELSE $DROP INC #0 ENDIF ;not the file keep looking
       = 44 ;if IPL program
       OVER OVER SUB IFZ ;if the selected file
        CONSOLE ;undo redirection
        $DUP $HEAD DROP $TRIM ;make a string containing word name
        $SWAP ;put actual filename on top
        RCONTROL #1 PUT ;we want to run and forget
        XLOAD ;hopefully run and forget
        S>Z
        ROT SWAP DROP #1 SWAP ROT ;exit menu to do the load
        Z>S
        #1 ;don't loop for more
       ELSE $DROP INC #0 ENDIF ;not the file keep looking
       DEFAULT $DROP #0 ;not a match so drop dir line and keep looking
       ENDCASE
       ;match must occur or endless loop ugliness but should be fine :)
      UNTIL
      DROP ;code counter
     ELSE
      DROP #0 ;invalid key try again
     ENDIF
   DEFAULT DROP #0 ;replace key with 0 to try again
   ENDCASE
  UNTIL
 ENDIF
 DROP ;max letter code
UNTIL ;menu is exited
END
;
; main autostarting menu for Combo1 system
; calls TSBE EUTL ECAL DMENU - specific to Combo[1] build,
; this part won't load if using RCONTROL/DMENU by itself
OCTAL DEFINE !MENU
DO ;until menu is exited
 CRLF CRLF
 "===== Combo1 Main Menu =====" $PRINT CRLF
 "T) Run TSBE to boot TSB-E" $PRINT CRLF
 "U) Run EUTL to patch/fix TSB-E" $PRINT CRLF
 "C) Run ECAL electronics calculator" $PRINT CRLF
 "D) Run DMENU to read docs or run IPL" $PRINT CRLF
 "Q) Quit this menu to HP-IPL/OS" $PRINT CRLF
 "H) Halt CPU to shut down system" $PRINT CRLF
 "Press a key to select: " $PRINT
 DO ;until the right key is pressed
  CHRIN ;get a keystroke
  CASE
  = 124 ;T
    CRLF CRLF TSBE #0 #1
  = 125 ;U
    CRLF CRLF EUTL #0 #1
  = 103 ;C
    CRLF CRLF ECAL #0 #1
  = 104 ;D
    CRLF DMENU #1 #1
  = 121 ;Q
    CRLF #1 #1
  = 110 ;H
    77675 102000 PUT ;HLT 0
    77676 127677 PUT ;JMP 77677,I
    77677 2 PUT ;location 2 to restart after c at the sim prompt
    77675 RUN ;halt the system
  DEFAULT #0
  ENDCASE
 UNTIL
UNTIL
END
;
CONSOLE