; Disk menu system - 12/11/07 minor fixes 6/9/10 6/13/11 ; Requires XDOS v1.26 or greater w/ fixed XDEL/XLOAD ; Requires PRESET word (HP-IPL/OS v1.11+) ; _DM - controls printing info before running binaries ; _RC - controls how the new CONSOLE behaves. ; CONSOLE - if _RC 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 # @ and $ in menu form ; without the prefixes. Supported filetypes... ; # - text file, display with XSHOW ; @ - system binary, load/run with XLOAD ; $ - ipl run file, load w/XLOAD, run, forget, return to menu ; Oddball characters used to avoid conflict with other files. ; !DM - autostart word that runs DMENU, forget if not wanted ; This is based on rcontrol.ipl (3/29/07), added support for binary ; files and saving basic, renamed RCONTROL variable to _RC, does ; regular exit instead of 2 RUN (original was called by another ; menu with a bunch of TSB-E-related stuff), fixed bugs. OCTAL VARIABLE _DM ;_DM variable controls printing of binary instructions... _DM 1 PUT ;print once then don't print unless disk rebooted ;_DM 2 PUT ;always print ;_DM 0 PUT ;never print ;set _DM and DGEN to set preference VARIABLE _RC _RC #0 PUT ; if _RC is 0 then does a normal CONSOLE and nothing else. ; if _RC 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 _RC GET IFNZ ;if _RC is not zero _RC #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 $ for text, binary, or run file. For run files ; 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. ; Uses mem locs 150-156, last mods 8/26/07 9/30/07 11/17/07 DEFINE DMENU _RC #0 PUT ;clear failed loads after page errors DO ;until user exits menu #0 ;master exit flag CRLF CRLF "=== HP-IPL/OS Disk 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 ;redirect console out to MS then fill block(s) with disk dir... ;11/17/07... XDIR output bigger than 1 block if too many files, ;recoding to record just filenames GetVol VolInfo GET IFNZ VolInfo INC INC GET VolInfo INC GET SBLA WKBUF R-1K WKBUF #0 VolInfo GET DEC +DO ;loop thru all dir entries DUP GET IFNZ ;if not zero DUP GET 20040 SUB IFNZ ;if not spaces #0 7 +DO DUP INDEX ADD GET PWRD +LOOP CRLF ;print filename ENDIF ENDIF 20 ADD ;increment ptr +LOOP DROP ;ptr ENDIF 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 letter of filename CASE = 100 #1 "Binary " ;@ = 44 #1 "Run IPL " ;$ = 43 #1 "Text " ;# DEFAULT #0 ENDCASE IFNZ ;if supported type SWAP DUP PCHR ") " $PRINT $PRINT ;print choice and type #0 17 $SLICE $TRIM $PRINT CRLF ;print the name INC SWAP ;increment letter counter OVER 133 SUB IFZ ;if past letter Z (fix 6/9/10 to display Z too) DROP #0 ;pretend there's no more files ENDIF ENDIF 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 ;what to do with it DUP 101 SUB IFZ "Nothing to do" $PRINT DROP DROP #1 #1 ELSE "1) Exit to prompt" $PRINT CRLF "2) Halt system (quit)" $PRINT CRLF ;only display next option if HP BASIC in alt mem ;uses memory locations 150-156 156 #0 PUT ;detection flag 100 150 6 A>CCOPY ;get 100-105 to 150-155 150 GET 124201 SUB IFZ 155 GET 002200 SUB IFZ "7) Save BASIC program" $PRINT CRLF 156 #1 PUT ;set flag for later ENDIF ENDIF "Press a key: " $PRINT DO ;until valid key CHRIN ;get a key DUP CASE = 61 ;if a 1 - exit menu CRLF ;for consistent spacing DROP DROP DROP #1 #1 #1 ;exit DMENU = 62 ;if a 2 - clear alt except for halt then save/swap system PRESET ;turn off interrupts and everything ALTSAVE ;just to get the swapper prog at 77000 ZAM CONSOLE ;zero alt, reset to PTR 150 102077 PUT ;a halt instruction 151 124060 PUT ;a jmp 60,i instruction (in case user continues) 150 2 2 C>ACOPY ;put halt/jmp in altmem locs 2-3 150 77000 PUT ;address of HP-IPL/OS swapper 150 60 #1 C>ACOPY ;put address in altmem loc 60 CRLF CRLF "Run 77000 to return to HP-IPL/OS" $PRINT CRLF 77000 RUN ;save HP-IPL/OS and halt to empty system = 67 ;if a 7 - save basic 156 GET IFNZ ;if basic was detected CRLF "File to save: " $PRINT $IN $LEN IFNZ ;if something was entered "@ " $SWAP $CAT ;add binary mark to name $DUP GetFile ;find file location IFNZ DROP DROP $DUP XDEL CRLF ENDIF ;if exists prompt to delete $DUP GetFile ;make sure it doesn't exist now IFNZ DROP DROP $DROP ELSE ;if user said no ignore otherwise... "Make autorun? " $PRINT CHRIN CRLF 131 SUB IFZ 5137 ELSE 2027 ENDIF ;patch accordingly 6/13/11 150 SWAP PUT 150 3 #1 C>ACOPY 174000 AM2F ;save to disk ENDIF CRLF ;menu will redisplay ENDIF ELSE DROP #0 ENDIF ;no basic, ignore key > 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 17 $SLICE $TRIM $SWAP $DROP ;turn into just filename (bf 12/11/07) #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 run-and-forget 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 _RC #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 = 100 ;@ if a binary file OVER OVER SUB IFZ ;if the selected file CRLF _DM GET IFNZ ;_DM must be non-zero message changed 6/13/11 "If binary doesn't support exit/reboot/etc then" $PRINT CRLF "halt (ctrl-E), run 77000 to return to HP-IPL/OS." $PRINT CRLF "Stock BCS apps require CRLF enters, if terminal" $PRINT CRLF "can't be set that way press ctrl-J after enter." $PRINT CRLF _DM GET #1 SUB IFZ _DM #0 PUT ENDIF ;if _DM=1 make _DM=0 ENDIF CRLF XLOAD ;load and run it #1 ;don't loop for more (shouldn't get here) ELSE $DROP INC #0 ENDIF ;not the file keep looking ;end of conditions 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 ; DEFINE !DM #0 S>SR ;so CHESS doesn't freak 9/2/07 DMENU END ; CONSOLE