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 EDCOLCOL+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 -------------------------