8855 REM ------ ROUTSMAL.BAS ----- a monochrome subset of ROUTINES.BAS ------
8860 REM
8865 REM 9000 outline the screen
8870 REM
8875 REM 9500 display centered message
8880 REM (display message at row and column in ROUTINES.BAS)
8885 REM
8890 REM 10000 edit a field at row and column
8895 REM
8900 REM 20000 select a file from the current directory 06/02/99
8905 REM 22000 select a file from any directory on the disk 02/22/01
8910 REM
8915 REM 32000 multiple selection menu
8920 REM 30000 point and shoot menu of up to 9 items
8925 REM 35000 scrolling point and shoot menu for >20 and <100 items
8930 REM
8935 REM *********************************************************************
8940 REM --------------------- OUTLINE THE SCREEN ----------------------------
8945 REM
8950 REM This subroutine outlines the screen with a box.
8965 REM
9000 KEY OFF:FOR A%=1 TO 10:KEY A%,"":NEXT A%
9010 LOCATE ,,0:COLOR 7,0:CLS
9020 TP=196:BT=196:MS=179:UL=218:LL=192:UR=191:LR=217
9025 REM TP=205:BT=205:MS=186:UL=201:LL=200:UR=187:LR=188
9030 REM TP=223:BT=220:MS=219:UL=219:LL=219:UR=219:LR=219
9035 ROW=1:LOCATE ROW,2:PRINT STRING$(78,CHR$(TP));
9040 ROW=25:LOCATE ROW,2:PRINT STRING$(78,CHR$(BT));
9045 COL=1:FOR ROW%=2 TO 24:LOCATE ROW%,COL:PRINT CHR$(MS);:NEXT ROW%
9050 COL=80:FOR ROW%=2 TO 24:LOCATE ROW%,COL:PRINT CHR$(MS);:NEXT ROW%
9055 LOCATE 1,1:PRINT CHR$(UL);:LOCATE 1,80:PRINT CHR$(UR);
9060 LOCATE 25,1:PRINT CHR$(LL);:LOCATE 25,80:PRINT CHR$(LR);
9065 RETURN
9070 REM
9075 REM
9460 REM *********************************************************************
9465 REM ------------------- DISPLAY CENTERED MESSAGE ------------------------
9470 REM
9475 REM This subroutine displays a message at the center of a specified row.
9480 REM
9485 REM enter with - MSG$="message", to display
9490 REM ROW= row on which to display "message"
9495 REM
9500 COL=41-INT((LEN(MSG$)/2))
9505 LOCATE ROW,COL,0:PRINT MSG$;
9510 RETURN
9515 REM
9930 REM *********************************************************************
9935 REM ---------------- EDIT A FIELD AT ROW AND COLUMN ---------------------
9940 REM
9945 REM This subroutine allows you to edit or enter a string. The editing
9950 REM keys work about the same as BASIC in the screen editing mode.
9955 REM
9960 REM enter with - ROW and COL=row and column at which to edit the string
9965 REM LNG=maximum length of string allowed
9970 REM TEMP$="string" to edit
9975 REM exit with - TEMP$="string" edited or entered
9980 REM EXIT$=key hit that exited routine, "ENTER" or "ESC"
9985 REM ESCAPE=-1 (TRUE) if ESCAPE key hit
9990 REM (for compatibility with old versions)
9995 REM
10000 LOCATE ,,0:INS=0:TEMP$=LEFT$(TEMP$,LNG)
10005 IF LEN(TEMP$)=LNG THEN EDCOL=COL+LEN(TEMP$)-1 ELSE EDCOL=COL+LEN(TEMP$)
10010 LOCATE ROW,COL,0:COLOR 0,7:PRINT TEMP$;
10015 LOCATE ROW,COL+LEN(TEMP$):PRINT SPACE$(LNG-LEN(TEMP$));
10020 L=LEN(TEMP$)
10025 AAAA$=MID$(TEMP$,EDCOL-COL+1,1)
10030 IF INS THEN LOCATE ROW,EDCOL:COLOR 15,0
10035 IF INS THEN PRINT AAAA$;:COLOR 0,7
10040 IF EDCOL=COL+LNG THEN EDCOL=EDCOL-1
10045 LOCATE ROW,EDCOL
10050 LOCATE,,1
10055 IN$=INKEY$:IF IN$="" THEN 10055 :REM WAIT FOR KEY
10060 IF IN$=CHR$(13) THEN EXIT$="ENTER":ESCAPE=0:GOTO 10325 :REM ENTER
10065 IF IN$=CHR$(27) THEN EXIT$="ESC":ESCAPE=-1:GOTO 10325 :REM ESCAPE
10070 IF IN$=CHR$(8) THEN 10180 :REM BACKSPACE
10075 IF IN$=CHR$(0)+CHR$(75) THEN 10225 :REM LEFT ARROW
10080 IF IN$=CHR$(0)+CHR$(77) THEN 10240 :REM RIGHT ARROW
10085 IF IN$=CHR$(0)+CHR$(79) THEN 10275 :REM END
10090 IF IN$=CHR$(0)+CHR$(82) THEN 10295 :REM INSERT
10095 IF IN$=CHR$(0)+CHR$(83) THEN 10305 :REM DELETE
10100 REM ----- allow only legitimate alphanumeric
10105 IF ASC(IN$)<32 OR ASC(IN$)>126 THEN GOSUB 10400:GOTO 10050
10110 REM ----- good character
10115 L=EDCOL-COL:IF INS THEN 10155
10120 REM ----- add character if at end of string
10125 IF EDCOL=COL+LEN(TEMP$) THEN TEMP$=TEMP$+IN$:EDCOL=EDCOL+1:GOTO 10010
10130 REM ----- add character in middle if not in insert mode
10135 TEMP$=LEFT$(TEMP$,L)+IN$+RIGHT$(TEMP$,LEN(TEMP$)-1-L):EDCOL=EDCOL+1
10140 IF EDCOL=COL+LNG THEN GOSUB 10400 :REM beep if typing over last char.
10145 GOTO 10010
10150 REM ----- in insert mode, check for full field
10155 IF LEN(TEMP$)=LNG THEN GOSUB 10400:GOTO 10010 :REM full field
10160 TEMP$=LEFT$(TEMP$,L)+IN$+RIGHT$(TEMP$,LEN(TEMP$)-L) :REM not full
10165 EDCOL=EDCOL+1:GOTO 10010
10170 REM ----- BACKSPACE -----
10175 REM ----- error if at leftmost column
10180 IF EDCOL=COL THEN GOSUB 10400:GOTO 10010
10185 REM ----- skip moving cursor left if the field is full
10190 IF LEN(TEMP$)=LNG AND EDCOL=COL+LNG-1 THEN 10215
10195 REM ----- normal backspace (in middle of field)
10200 L=EDCOL-1-COL:TEMP$=LEFT$(TEMP$,L)+RIGHT$(TEMP$,LEN(TEMP$)-1-L)
10205 EDCOL=EDCOL-1:GOTO 10010
10210 REM ----- backspace if at rightmost column
10215 TEMP$=LEFT$(TEMP$,LEN(TEMP$)-1):GOTO 10010
10220 REM ----- LEFT ARROW -----
10225 INS=0:IF EDCOL>COL THEN EDCOL=EDCOL-1:GOTO 10010
10230 GOSUB 10400:GOTO 10010 :REM error if left col
10235 REM ----- RIGHT ARROW -----
10240 INS=0:IF EDCOL
COL+LNG THEN EDCOL=COL+LNG:GOTO 10025
10290 REM ----- INSERT -----
10295 IF INS THEN INS=0:GOTO 10010 ELSE INS=-1:GOTO 10010
10300 REM ----- DELETE -----
10305 INS=0:L=EDCOL-COL
10310 IF EDCOL>=COL+LEN(TEMP$) THEN GOSUB 10400:GOTO 10010
10315 TEMP$=LEFT$(TEMP$,L)+RIGHT$(TEMP$,LEN(TEMP$)-L-1):GOTO 10010
10320 REM ----- COMMON EXIT -----
10325 REM remove blanks at end
10330 IF RIGHT$(TEMP$,1)=CHR$(255) THEN TEMP$=LEFT$(TEMP$,LEN(TEMP$)-1):GOTO 10330
10335 REM change blanks in middle to spaces
10340 FOR AAAA%=1 TO LEN(TEMP$)
10345 IF MID$(TEMP$,AAAA%,1)=CHR$(255) THEN MID$(TEMP$,AAAA%,1)=" "
10350 NEXT AAAA%
10355 REM redisplay string
10360 LOCATE ROW,COL,0:COLOR 7,0
10365 PRINT TEMP$+SPACE$(LNG-LEN(TEMP$));
10370 RETURN
10375 REM
10395 REM ----- BEEP IF ERROR -----
10400 BEEP:RETURN
10405 REM
19930 REM ********************************************************************
19935 REM ------------- SELECT A FILE FROM THE CURRENT DIRECTORY -------------
19940 REM
19945 REM This subroutine allows you to move up and down among a list of
19950 REM files and select one.
19955 REM
19960 REM enter with EXT$, FILEMSG$
19965 REM ALPHA=1 or 0, TO ALPHABETIZE OR NOT
19970 REM exit with FILE$, NUMFILES
19975 REM EXIT$=key hit that exited routine, "ENTER" or "ESC"
19980 REM ESCAPE=-1 (TRUE) if ESCAPE key hit
19985 REM (for compatibility with old versions)
19990 REM DOSERROR$="NONE", "DISK"
19995 REM
20000 LOCATE ,,0:COLOR 7,0:CLS
20005 COL=35
20010 SHEL$="DIR *."+EXT$+" > FILES.TMP":SHELL SHEL$
20015 ON ERROR GOTO 20035
20020 OPEN "FILES.TMP" FOR INPUT AS 1
20025 IF LOF(1)=0 THEN CLOSE #1:GOTO 20040
20030 GOTO 20055
20035 RESUME 20040
20040 DOSERROR$="DISK":NUMFILES=0:FILE$=""
20045 ON ERROR GOTO 0:COLOR 7,0:RETURN
20050 REM -----
20055 ON ERROR GOTO 0
20060 DOSERROR$="NONE"
20065 NUMFILES=0:DIM FILENAME$(1000)
20070 REM -----
20075 IF EOF(1) THEN 20130
20080 LINE INPUT #1,FILE$
20085 IF LEFT$(FILE$,1)=" " THEN 20075
20090 IF LEFT$(FILE$,1)="." THEN 20075
20095 IF MID$(FILE$,9,1)<>" " THEN 20075
20100 IF VAL(MID$(FILE$,14,13))=0 THEN 20075
20105 FILENAME$(NUMFILES+1)=LEFT$(FILE$,8)
20110 NUMFILES=NUMFILES+1
20115 IF NUMFILES>1000 THEN 20130
20120 GOTO 20075
20125 REM -----
20130 CLOSE 1:KILL "FILES.TMP"
20135 IF NUMFILES=0 THEN FILE$="":GOTO 20535
20140 IF ALPHA=0 THEN 20180
20145 REM ----- BUBBLE SORT
20150 LOCATE 12,36:PRINT "Sorting...";
20155 EXCHFLAG=0:ARRAYNUM=1
20160 IF FILENAME$(ARRAYNUM)>FILENAME$(ARRAYNUM+1) THEN SWAP FILENAME$(ARRAYNUM),FILENAME$(ARRAYNUM+1):EXCHFLAG=1
20165 ARRAYNUM=ARRAYNUM+1:IF ARRAYNUM1 THEN OLDROW=CURROW:CURROW=CURROW-1:GOTO 20490
20395 IF SRTROW>1 THEN SRTROW=SRTROW-1:GOTO 20290
20400 GOSUB 20480:GOTO 20340
20405 IF CURROWMAXROW AND SRTROW<=NUMFILES-19 THEN SRTROW=SRTROW+1:GOTO 20290
20415 GOSUB 20480:GOTO 20340
20420 IF SRTROW>18 THEN SRTROW=SRTROW-18:GOTO 20290
20425 IF SRTROW<>1 THEN SRTROW=1:GOTO 20290
20430 IF CURROW<>1 THEN CURROW=1:GOTO 20290
20435 GOSUB 20480:GOTO 20340
20440 IF SRTROW+18<=NUMFILES-19 THEN SRTROW=SRTROW+18:GOTO 20290
20445 IF SRTROW<=NUMFILES-19 THEN SRTROW=NUMFILES-18:GOTO 20290
20450 IF NUMFILES>MAXROW AND CURROW<>MAXROW THEN CURROW=MAXROW:GOTO 20290
20455 IF CURROW<>MAXROW THEN CURROW=MAXROW:GOTO 20290
20460 GOSUB 20480:GOTO 20340
20465 IF ALPHA=0 THEN ALPHA=1 ELSE ALPHA=0
20470 ERASE FILENAME$:GOTO 20000
20475 REM ----- BEEP ON ERROR
20480 RETURN
20485 REM ----- HIGHLIGHT NEW FILE
20490 LOCATE OLDROW+3,COL+2:COLOR 7,0
20495 PRINT FILENAME$(OLDROW-1+SRTROW);
20500 LOCATE CURROW+3,COL+2:COLOR 0,7
20505 PRINT FILENAME$(CURROW-1+SRTROW);
20510 GOTO 20340
20515 REM ----- FILE WAS SELECTED
20520 FILE$=FILENAME$(CURROW-1+SRTROW)
20525 IF RIGHT$(FILE$,1)=" " THEN FILE$=LEFT$(FILE$,LEN(FILE$)-1):GOTO 20525
20530 REM -----
20535 ERASE FILENAME$
20540 COLOR 7,0:RETURN
20545 REM
21920 REM ---------- SELECT A FILE FROM ANY DIRECTORY ON THE DISK ------------
21925 REM
21930 REM This subroutine allows you to move up and down among a list of
21935 REM files and select one, or to move to another directory to continue
21940 REM the selection process. The file extension can be specified or all
21945 REM extensions allowed.
21950 REM
21955 REM enter with EXT$ (or *), FILEMSG$, DIRPATH$
21960 REM ALPHA=alphabetical sort type
21965 REM 0=none, 1=file name, 2=file name then extension
21970 REM exit with FILE$, EXT$, DIRPATH$, NUMFILES
21975 REM EXIT$=key hit that exited routine, "ENTER" or "ESC"
21980 REM ESCAPE=-1 (TRUE) if ESCAPE key hit
21985 REM (for compatibility with old versions)
21990 REM DOSERROR$="NONE", "DISK"
21995 REM
22000 LOCATE ,,0:COLOR 7,0:CLS
22005 IF EXT$="*" THEN DIR1$="Root Directory":DIR2$="Up a Directory"
22010 IF EXT$<>"*" THEN DIR1$="Root Dir":DIR2$="Up a Dir"
22015 IF EXT$="*" THEN EXTOFF=5 ELSE EXTOFF=0
22020 IF EXT$="*" THEN COL=32 ELSE COL=34
22025 REM -----
22030 SHEL$="DIR "+DIRPATH$+"*.* > FILES.TMP":SHELL SHEL$
22035 ON ERROR GOTO 22055
22040 OPEN "FILES.TMP" FOR INPUT AS 3
22045 IF LOF(3)=0 THEN CLOSE #1:GOTO 22060
22050 GOTO 22075
22055 RESUME 22060
22060 DOSERROR$="DISK":NUMFILES=0:FILE$=""
22065 ON ERROR GOTO 0:COLOR 7,0:RETURN
22070 REM -----
22075 ON ERROR GOTO 0
22080 DIM FILENAME$(1000):NUMFILES=0:NUMFIL=0:ROOTFLAG=1
22085 OLDDIRPATH$=DIRPATH$:DOSERROR$="NONE":EXIT$=""
22090 REM -----
22095 IF EOF(3) THEN 22205
22100 LINE INPUT #3,FILE$
22105 IF INSTR(FILE$,"Directory")=0 THEN 22115
22110 DIRPATH$=MID$(FILE$,INSTR(FILE$,":\")+1,63):GOTO 22095
22115 IF LEFT$(FILE$,2)=".." THEN FILE$=DIR2$+" ":ROOTFLAG=0:GOTO 22175
22120 IF LEFT$(FILE$,1)="." THEN FILE$=DIR1$+ " ":ROOTFLAG=0:GOTO 22175
22125 IF INSTR(FILE$,"")=0 THEN 22145
22130 FILE$=" "+LEFT$(FILE$,8):REM SPACE FOR ALPHABETIZING, "\" LATER
22135 IF EXT$="*" THEN FILE$=FILE$+" "
22140 GOTO 22180
22145 IF LEFT$(FILE$,1)=" " OR MID$(FILE$,9,1)<>" " THEN 22095
22150 IF INSTR(FILE$,"FILES TMP ")<>0 THEN 22095
22155 IF EXT$="*" THEN 22165
22160 IF MID$(FILE$,10,3)<>EXT$ THEN 22095
22165 NUMFILES=NUMFILES+1
22170 IF VAL(MID$(FILE$,14,13))=0 THEN 22095
22175 FILE$=LEFT$(FILE$,9+EXTOFF)
22180 FILENAME$(NUMFIL+1)=FILE$+SPACE$(14-LEN(FILE$))
22185 NUMFIL=NUMFIL+1
22190 IF NUMFIL>1000 THEN 22205
22195 GOTO 22095
22200 REM -----
22205 CLOSE 3:KILL "FILES.TMP"
22210 IF NUMFIL=0 THEN FILE$="":GOTO 22800
22215 IF ALPHA=0 THEN 22290
22220 REM ----- BUBBLE SORT BY FILE NAME
22225 LOCATE 12,31:PRINT "Sorting by file name...";
22230 EXCHFLAG=0:IF ROOTFLAG=1 THEN ARRAYNUM=1 ELSE ARRAYNUM=3
22235 IF FILENAME$(ARRAYNUM)>FILENAME$(ARRAYNUM+1) THEN SWAP FILENAME$(ARRAYNUM),FILENAME$(ARRAYNUM+1):EXCHFLAG=1
22240 ARRAYNUM=ARRAYNUM+1:IF ARRAYNUMMID$(FILENAME$(ARRAYNUM+1),10,3) THEN SWAP FILENAME$(ARRAYNUM),FILENAME$(ARRAYNUM+1):EXCHFLAG=1
22275 ARRAYNUM=ARRAYNUM+1:IF ARRAYNUM0 THEN 22380
22370 MSG$="There are no files in the current directory with the extension "+EXT$
22375 GOTO 22385
22380 MSG$=FILEMSG$
22385 ROW=1:MCOL=41-INT((LEN(MSG$)/2))
22390 LOCATE ROW,MCOL:PRINT MSG$;
22395 ROW=3:MSG$="Directory of "+DIRPATH$
22400 MCOL=41-INT((LEN(MSG$)/2)):LOCATE ROW,MCOL:PRINT MSG$;
22405 ROW=25:MSG$=CHR$(24)+CHR$(25)+"=move, PgUp/PgDn=more files, ENTER=Select"
22410 IF ALPHA=0 THEN MSG$=MSG$+", A=alphabetize by file name"
22415 IF ALPHA=1 THEN MSG$=MSG$+", A=alphabetize by extension"
22420 MCOL=41-INT((LEN(MSG$)/2))
22425 LOCATE ROW,MCOL:PRINT MSG$;
22430 REM -----
22435 SRTROW=1:CURROW=1:OLDROW=CURROW
22440 MAXROW=19:IF NUMFIL<19 THEN MAXROW=NUMFIL
22445 REM ----- DISPLAY FILE NAMES
22450 FOR DISPROW=1 TO MAXROW
22455 LOCATE DISPROW+4,COL+2
22460 COLOR 7,0
22465 IF LEFT$(FILENAME$(DISPROW-1+SRTROW),4)=LEFT$(DIR1$,4) THEN COLOR 15,0
22470 IF LEFT$(FILENAME$(DISPROW-1+SRTROW),4)=LEFT$(DIR2$,4) THEN COLOR 15,0
22475 IF LEFT$(FILENAME$(DISPROW-1+SRTROW),1)="\" THEN COLOR 15,0
22480 PRINT FILENAME$(DISPROW-1+SRTROW);
22485 NEXT DISPROW
22490 REM ----- MOVE THROUGH FILE NAMES AND SELECT ONE
22495 LOCATE CURROW+4,COL+2,0:COLOR 0,7
22500 PRINT FILENAME$(CURROW-1+SRTROW);
22505 LOCATE CURROW+4,COL+2:COLOR 7,0
22510 REM -----
22515 IN$=INKEY$:IF IN$<>"" THEN 22515
22520 IN$=INKEY$:IF IN$="" THEN 22520
22525 IF IN$=CHR$(13) THEN EXIT$="ENTER":ESCAPE=0::GOTO 22720
22530 IF IN$=CHR$(27) THEN EXIT$="ESC":ESCAPE=-1:FILE$="":GOTO 22830
22535 IF IN$=CHR$(0)+CHR$(72) THEN 22570:REM UP
22540 IF IN$=CHR$(0)+CHR$(80) THEN 22585:REM DOWN
22545 IF IN$=CHR$(0)+CHR$(73) THEN 22600:REM PAGE UP
22550 IF IN$=CHR$(0)+CHR$(81) THEN 22620:REM PAGE DOWN
22555 IF IN$="A" OR IN$="a" THEN 22645
22560 GOSUB 22660:GOTO 22520
22565 REM -----
22570 IF CURROW>1 THEN OLDROW=CURROW:CURROW=CURROW-1:GOTO 22670
22575 IF SRTROW>1 THEN SRTROW=SRTROW-1:GOTO 22450
22580 GOSUB 22660:GOTO 22520
22585 IF CURROWMAXROW AND SRTROW<=NUMFIL-19 THEN SRTROW=SRTROW+1:GOTO 22450
22595 GOSUB 22660:GOTO 22520
22600 IF SRTROW>18 THEN SRTROW=SRTROW-18:GOTO 22450
22605 IF SRTROW<>1 THEN SRTROW=1:GOTO 22450
22610 IF CURROW<>1 THEN CURROW=1:GOTO 22450
22615 GOSUB 22660:GOTO 22520
22620 IF SRTROW+18<=NUMFIL-19 THEN SRTROW=SRTROW+18:GOTO 22450
22625 IF SRTROW<=NUMFIL-19 THEN SRTROW=NUMFIL-18:GOTO 22450
22630 IF NUMFIL>MAXROW AND CURROW<>MAXROW THEN CURROW=MAXROW:GOTO 22450
22635 IF CURROW<>MAXROW THEN CURROW=MAXROW:GOTO 22450
22640 GOSUB 22660:GOTO 22520
22645 IF ALPHA=0 THEN ALPHA=1 ELSE IF ALPHA=1 THEN ALPHA=2 ELSE ALPHA=0
22650 ERASE FILENAME$:DIRPATH$=OLDDIRPATH$:GOTO 22000
22655 REM ----- BEEP ON ERROR
22660 RETURN
22665 REM ----- HIGHLIGHT NEW FILE
22670 LOCATE OLDROW+4,COL+2
22675 COLOR 7,0
22680 IF LEFT$(FILENAME$(OLDROW-1+SRTROW),4)=LEFT$(DIR1$,4) THEN COLOR 15,0
22685 IF LEFT$(FILENAME$(OLDROW-1+SRTROW),4)=LEFT$(DIR2$,4) THEN COLOR 15,0
22690 IF LEFT$(FILENAME$(OLDROW-1+SRTROW),1)="\" THEN COLOR 15,0
22695 PRINT FILENAME$(OLDROW-1+SRTROW);
22700 LOCATE CURROW+4,COL+2:COLOR 0,7
22705 PRINT FILENAME$(CURROW-1+SRTROW);
22710 GOTO 22520
22715 REM ----- SELECTION WAS MADE
22720 FILE$=FILENAME$(CURROW-1+SRTROW)
22725 REM ----- REMOVE TRAILING SPACES
22730 IF RIGHT$(FILE$,1)=" " THEN FILE$=LEFT$(FILE$,LEN(FILE$)-1):GOTO 22730
22735 REM ----- DIRECTORY CHANGES
22740 IF LEFT$(FILE$,1)<>"\" THEN 22760
22745 IF DIRPATH$="\" THEN DIRPATH$=FILE$+"\":GOTO 22755
22750 IF DIRPATH$<>"\" THEN DIRPATH$=DIRPATH$+FILE$+"\"
22755 ERASE FILENAME$:GOTO 22000
22760 IF FILE$<>DIR1$ THEN 22775
22765 DIRPATH$="\"
22770 ERASE FILENAME$:GOTO 22000
22775 IF FILE$<>DIR2$ THEN 22800
22780 DIRPATH$=LEFT$(DIRPATH$,LEN(DIRPATH$)-1)
22785 IF RIGHT$(DIRPATH$,1)<>"\" THEN 22780
22790 ERASE FILENAME$:GOTO 22000
22795 REM ----- SEPARATE FILE AND EXTENSION IF ALL FILES WERE SPECIFIED
22800 IF EXT$<>"*" THEN 22810
22805 EXT$="":IF LEN(FILE$)>8 THEN EXT$=MID$(FILE$,10,3)
22810 IF LEFT$(EXT$,1)=" " THEN EXT$=RIGHT$(EXT$,LEN(EXT$)-1):GOTO 22810
22815 FILE$=LEFT$(FILE$,9)
22820 IF RIGHT$(FILE$,1)=" " THEN FILE$=LEFT$(FILE$,LEN(FILE$)-1):GOTO 22820
22825 REM -----
22830 ERASE FILENAME$
22835 IF DIRPATH$<>"\" THEN DIRPATH$=DIRPATH$+"\"
22840 COLOR 7,0:RETURN
22845 REM
29905 REM ********************************************************************
29910 REM ---------------------- POINT AND SHOOT MENU ------------------------
29915 REM
29920 REM This subroutine allows you to set up a menu of up to 9 items, and
29925 REM select an item with the arrow keys and ENTER, or use the numbers
29930 REM 1-9 or function keys F1-F9. Displays a message at top. Item names
29935 REM must be in order and none may be skipped. The ROW and COL must
29940 REM allow all of the menu to be displayed on the screen.
29945 REM
29950 REM enter with ITEM$(1)="ITEM 1 message",(up to 76 chars.),ITEM$(2), etc.
29955 REM (array must be DIMinsioned before using this routine)
29960 REM MSG$="menu message or name", (up to 76 characters)
29965 REM ROW, COL=upper left corner of menu
29970 REM exit with -ITEM = 1-9, item selected
29975 REM ITEM$ = ITEM$(1)-ITEM$(9), depending on item selected
29980 REM ESCAPE=-1 (TRUE) if ESCAPE key hit
29985 REM (for compatibility with old versions)
29990 REM EXIT$=key hit that exited routine, "ENTER" OR "ESC"
29995 REM
30000 KEY OFF:FOR A%=1 TO 10:KEY A%,"":NEXT A%
30005 NUMITEMS=0
30010 FOR A%=1 TO 9:IF ITEM$(A%)="" THEN 30020
30015 NUMITEMS=NUMITEMS+1:NEXT A%
30020 IF NUMITEMS+ROW+3>25 THEN ROW=25-3-NUMITEMS
30025 REM ------ find maximum length and pad the rest
30030 MAXLEN=LEN(MSG$)
30035 FOR MLOOP%=1 TO NUMITEMS
30040 IF LEN(ITEM$(MLOOP%))>MAXLEN THEN MAXLEN=LEN(ITEM$(MLOOP%))
30045 NEXT MLOOP%
30050 IF LEN(MSG$)80 THEN COL=80-3-MAXLEN
30075 REM ------ display the menu
30080 LOCATE ,,0
30085 TP=196:BT=196:LS=195:RS=180:MS=179:MM=196:UL=218:LL=192:UR=191:LR=217:DN=194:RT=195
30090 IROW=ROW:ICOL=COL
30095 LOCATE IROW,ICOL:COLOR 7,0
30100 PRINT CHR$(UL)+STRING$(MAXLEN+2,TP)+CHR$(UR);
30105 LOCATE IROW+1,ICOL:PRINT CHR$(MS)+" ";
30110 COLOR 7,0:PRINT MSG$;
30115 COLOR 7,0:PRINT " "+CHR$(MS);
30120 LOCATE IROW+2,ICOL:COLOR 7,0
30125 PRINT CHR$(LS)+STRING$(MAXLEN+2,MM)+CHR$(RS);
30130 FOR PLOOP%=1 TO NUMITEMS
30135 LOCATE IROW+2+PLOOP%,ICOL
30140 PRINT CHR$(MS)+" "+ITEM$(PLOOP%)+" "+CHR$(MS);
30145 NEXT PLOOP%
30150 LOCATE IROW+3+NUMITEMS,ICOL
30155 PRINT CHR$(LL)+STRING$(MAXLEN+2,BT)+CHR$(LR);
30160 REM
30165 REM ------ move through the items and select one
30170 IROW=1
30175 OLDIROW=IROW:ICOL=COL+2
30180 LOCATE OLDIROW+ROW+2,ICOL:COLOR 7,0:PRINT ITEM$(OLDIROW);
30185 LOCATE IROW+ROW+2,ICOL:COLOR 0,7:PRINT ITEM$(IROW);
30190 IN$=INKEY$:IF IN$="" THEN 30190
30195 IF IN$=CHR$(27) THEN EXIT$="ESC":ESCAPE=-1:GOTO 30265
30200 IF IN$=CHR$(13) THEN EXIT$="ENTER":ESCAPE=0:GOTO 30265
30205 IF LEN(IN$)=1 THEN 30215
30210 V=ASC(RIGHT$(IN$,1))-58:GOTO 30220:REM FUNCTION KEY
30215 V=VAL(IN$)
30220 IF V>=1 AND V<=9 AND V<=NUMITEMS THEN OLDIROW=IROW:IROW=V:EXIT$="ENTER":ESCAPE=0:GOTO 30265
30225 IF IN$=CHR$(0)+CHR$(72) THEN 30240:REM UP
30230 IF IN$=CHR$(0)+CHR$(80) THEN 30250:REM DOWN
30235 BEEP:GOTO 30190
30240 OLDIROW=IROW:IF IROW>1 THEN IROW=IROW-1:GOTO 30180
30245 IROW=NUMITEMS:GOTO 30180
30250 OLDIROW=IROW:IF IROW25 THEN ROW=25-3-NUMITEMS
32045 REM ----- FIND MAX LNG AND PAD SHORTER ONES
32050 MAXLEN=LEN(MSG$)-5
32055 FOR MLOOP%=1 TO NUMITEMS
32060 IF LEN(ITEM$(MLOOP%))>MAXLEN THEN MAXLEN=LEN(ITEM$(MLOOP%))
32065 NEXT MLOOP%
32070 IF LEN(MSG$)80 THEN COL=80-3-MAXLEN
32095 REM ----- DISPLAY MENU
32100 LOCATE ,,0
32105 TP=196:BT=196:LS=195:RS=180:MS=179:MM=196:UL=218:LL=192:UR=191:LR=217:DN=194:RT=195
32110 IROW=ROW:ICOL=COL
32115 LOCATE IROW,ICOL:COLOR 7,0
32120 PRINT CHR$(UL)+STRING$(MAXLEN+7,TP)+CHR$(UR);
32125 LOCATE IROW+1,ICOL:PRINT CHR$(MS)+SPACE$(MAXLEN+6);" "+CHR$(MS);
32130 LOCATE IROW+1,ICOL+2:PRINT MSG$;
32135 REM
32140 LOCATE IROW+2,ICOL:COLOR 7,0
32145 PRINT CHR$(LS)+STRING$(MAXLEN+7,MM)+CHR$(RS);
32150 FOR PLOOP=1 TO NUMITEMS
32155 LOCATE IROW+2+PLOOP,ICOL
32160 PRINT CHR$(MS)+" "+ITEM$(PLOOP)+" ";
32165 SROW=PLOOP:GOSUB 32350:REM PRINT SELECT MESSAGE
32170 PRINT " "+CHR$(MS);
32175 NEXT PLOOP
32180 LOCATE IROW+3+NUMITEMS,ICOL
32185 PRINT CHR$(LL)+STRING$(MAXLEN+7,BT)+CHR$(LR);
32190 REM ----- MOVE THROUGH ITEMS AND SELECT STATUS
32195 IROW=1:OLDIROW=IROW:ICOL=COL+2
32200 LOCATE OLDIROW+ROW+2,ICOL:COLOR 7,0:PRINT ITEM$(OLDIROW);
32205 LOCATE OLDIROW+ROW+2,ICOL+MAXLEN+2:SROW=OLDIROW:GOSUB 32350
32210 LOCATE IROW+ROW+2,ICOL:COLOR 0,7:PRINT ITEM$(IROW);
32215 LOCATE IROW+ROW+2,ICOL+MAXLEN+2:SROW=IROW:COLOR 7,0:GOSUB 32350
32220 IN$=INKEY$:IF IN$="" THEN 32220
32225 IF IN$=CHR$(27) THEN EXIT$="ESC":ESCAPE=-1:GOTO 32315
32230 IF IN$=CHR$(13) THEN EXIT$="ENTER":ESCAPE=0:GOTO 32315
32235 IF IN$=CHR$(0)+CHR$(72) THEN 32255:REM UP
32240 IF IN$=CHR$(0)+CHR$(80) THEN 32265:REM DOWN
32245 IF IN$=" " THEN 32280
32250 GOTO 32220
32255 OLDIROW=IROW:IF IROW>1 THEN IROW=IROW-1:GOTO 32200
32260 IROW=NUMITEMS:GOTO 32200
32265 OLDIROW=IROW:IF IROW20 AND <100 ITEMS -------
34915 REM
34920 REM This subroutine allows you to set up a menu of items and select
34925 REM an item with the arrow keys and ENTER. Displays a message at top.
34930 REM Item names must be in order and none may be skipped.
34945 REM
34950 REM enter with ITEM$(1)="ITEM 1 message",(up to 76 chars.),ITEM$(2), etc.
34955 REM (array must be DIMinsioned before using this routine)
34960 REM MSG$="menu message or name", (up to 76 characters)
34970 REM exit with -ITEM = 1-9, item selected
34975 REM ITEM$ = ITEM$(1)-ITEM$(n), depending on item selected
34980 REM ESCAPE=-1 (TRUE) if ESCAPE key hit
34990 REM EXIT$=key hit that exited routine, "ENTER" OR "ESC"
34995 REM
35000 KEY OFF:FOR A%=1 TO 10:KEY A%,"":NEXT A%
35005 NUMITEMS=0
35010 FOR A%=1 TO 100:IF ITEM$(A%)="" THEN 35020
35015 NUMITEMS=NUMITEMS+1:NEXT A%
35020 IF NUMITEMS+ROW+3>25 THEN ROW=25-3-NUMITEMS
35025 REM ------ FIND MAXIMUM LENGTH AND PAD THE REST
35030 MAXLEN=0
35035 FOR MLOOP%=1 TO NUMITEMS
35040 IF LEN(ITEM$(MLOOP%))>MAXLEN THEN MAXLEN=LEN(ITEM$(MLOOP%))
35045 NEXT MLOOP%
35050 FOR MLOOP%=1 TO NUMITEMS
35055 IF LEN(ITEM$(MLOOP%))1 THEN OLDROW=CURROW:CURROW=CURROW-1:GOTO 35360
35275 IF SRTROW>1 THEN SRTROW=SRTROW-1:GOTO 35175
35280 GOSUB 35350:GOTO 35225
35285 IF CURROWMAXROW AND SRTROW<=NUMITEMS-19 THEN SRTROW=SRTROW+1:GOTO 35175
35295 GOSUB 35350:GOTO 35225
35300 IF SRTROW>18 THEN SRTROW=SRTROW-18:GOTO 35175
35305 IF SRTROW<>1 THEN SRTROW=1:GOTO 35175
35310 IF CURROW<>1 THEN CURROW=1:GOTO 35175
35315 GOSUB 35350:GOTO 35225
35320 IF SRTROW+18<=NUMITEMS-19 THEN SRTROW=SRTROW+18:GOTO 35175
35325 IF SRTROW<=NUMITEMS-19 THEN SRTROW=NUMITEMS-18:GOTO 35175
35330 IF NUMITEMS>MAXROW AND CURROW<>MAXROW THEN CURROW=MAXROW:GOTO 35175
35335 IF CURROW<>MAXROW THEN CURROW=MAXROW:GOTO 35175
35340 GOSUB 35350:GOTO 35225
35345 REM ----- BEEP ON ERROR
35350 BEEP:RETURN
35355 REM ----- HIGHLIGHT NEW ITEM
35360 LOCATE OLDROW+3,COL+2:COLOR 7,0:PRINT ITEM$(OLDROW-1+SRTROW);
35365 LOCATE CURROW+3,COL+2:COLOR 0,7:PRINT ITEM$(CURROW-1+SRTROW);
35370 GOTO 35225
35375 REM ----- ITEM WAS SELECTED
35380 ITEM$=ITEM$(CURROW-1+SRTROW)
35385 IF RIGHT$(ITEM$,1)=" " THEN ITEM$=LEFT$(ITEM$,LEN(ITEM$)-1):GOTO 35385
35390 ITEM=CURROW-1+SRTROW
35395 REM ----- HIGHLIGHT NEW ITEM
35400 LOCATE OLDROW+3,COL+2:COLOR 7,0:PRINT ITEM$(OLDROW-1+SRTROW);
35405 LOCATE CURROW+3,COL+2:COLOR 0,7:PRINT ITEM$(CURROW-1+SRTROW);
35410 REM ----- EXIT
35415 FOR A%=1 TO NUMITEMS:ITEM$(A%)="":NEXT A%
35420 COLOR 7,0:RETURN
35425 REM
35430 REM ---------------------- end of ROUTSMAL.BAS -------------------------