100 REM >> Title: MENU.BAS Version #: 2.0 110 ' Released to NLS: 01 August, 1983 120 ' Written for: 130 ' KAYPRO Corporation 140 ' Educational Programming Division 150 ' Solana Beach, CA. 92075 160 ' By: r. carter, Simple Software, San Diego, CA 170 ' Copyright (c) 1983, KAYPRO Corporation 999 'end intro 1000 REM ******************************************************* 1020 ' * Initialization Section * 1040 ' ******************************************************* 1110 ' *** Standard KAYPRO Program Initializations *** 1140 ON ERROR GOTO 50000 ' *** Pointer to Error Processing 1160 BELL$ = CHR$(7) ' *** Bell character 1180 CLS$ = CHR$(26) ' *** Clear screen and home 1190 BS$ = CHR$(8) 1200 CR$ = CHR$(13) : LF$ = CHR$(10) ' *** Carriage Return/Line Feed 1210 CRLF$ = CHR$(13)+CHR$(10) 1220 DL$ = CHR$(27) + CHR$(82) ' *** Delete Line 1240 ELR$ = CHR$(24) ' *** Erase Line Right 1260 EES$ = CHR$(23)' *** Erase to End of Screen 1280 EXT$ = CHR$(64) ' the @ sign 1300 HOME$ = CHR$(30) 1320 IL$ = CHR$(27) + CHR$(69)' *** Insert Line 1340 SW% = 78 : WIDTH 255 1360 DEF FNCENTER$(A$) = SPACE$((SW%-LEN(A$))/2) + A$ ' *** Center a String on a line 1400 DEF FNPOSCUR$(LP%,CP%)=CHR$(27)+"="+CHR$(31+LP%)+CHR$(31+CP%) ' *** Position Cursor 1500 REM *** PARTICULAR PROGRAM INITIALIZATONS *** 1502 DIM PROG$(18),TITL$(18) 1504 PUSING$ = " \ \ \ \" 1506 NYSTR$ = "That option is not yet implemented..." 1510 PROG$(1) = " 1 - TUTR.01" 1520 PROG$(2) = " 2 - TUTR.02" 1530 PROG$(3) = " 3 - TUTR.03" 1540 PROG$(4) = " 4 - TUTR.04" 1550 PROG$(5) = " 5 - TUTR.05" 1560 PROG$(6) = " 6 - TUTR.06" 1570 PROG$(7) = " 7 - TUTR.07" 1580 PROG$(8) = " 8 - TUTR.08" 1590 PROG$(9) = " 9 - TUTR.09" 1600 PROG$(10) = "10 - MENU.10" 1610 PROG$(11) = "11 - MENU.11" 1620 PROG$(12) = "12 - TUTR.12" 1630 PROG$(13) = "13 - TUTR.13" 1640 PROG$(14) = "14 - TUTR.14" 1650 PROG$(15) = "15 - MENU.15" 1660 PROG$(16) = "16 - MENU.16" 1670 PROG$(17) = "17 - MENU.17" 1999 REM *** End of initialization 2000 REM ********************************************************* 2020 ' * Title Page * 2040 ' ********************************************************* 2050 PRINT CLS$; 2060 TITLE$ = "MBASIC TUTOR" 2070 PRINT FNPOSCUR$(2,1); 2080 PRINT FNCENTER$(TITLE$) 2090 PRINT FNCENTER$("A programmed learning experience in programming") 2300 ' *** Screen credit for non-linear 2310 PRINT FNPOSCUR$(20,50);"KAYPRO " 2320 PRINT FNPOSCUR$(21,50);"Educational Programming" 2340 PRINT FNPOSCUR$(22,50);"Solana Beach, California" 2350 PRINT FNPOSCUR$(23,50);"(portions copyrighted, 1983)" 2999 ' *** End of the title page / drop into menu/driver 3000 ' ******************************* *** MAIN PROGRAM FOR MENU *** ******************************* 3002 GOSUB 43500 3010 PRINT FNPOSCUR$(4,1) 3020 FOR I%=1 TO 9 3030 PRINT USING PUSING$;TITL$(I%),TITL$(I%+9) 3040 NEXT I% 3070 PRINT FNPOSCUR$(17,1)" Press @ to exit to CP/M" 3080 'PRINT FNPOSCUR$(18,1)" Press D, followed by the number for a brief description..." 3090 PRINT FNPOSCUR$(15,1);FNCENTER$("SELECTION --> ");: GOSUB 43100 3100 IF LENSTR% = 0 THEN 3090 3110 IF LEFT$(CVTSTR$,1) = "@" THEN 61000 3120 IF LEFT$(CVTSTR$,1) = "D" THEN GOSUB 43200: GOTO 3140 3130 GOTO 3300 3140 RUN 3300 ' ********************************** *** Here we get programs *** ********************************** 3302 THIS = VAL (CVTSTR$) 3304 IF THIS < 1 OR THIS > 17 THEN 43300 3306 PRINT CLS$;FNPOSCUR$(10,25); 3310 PRINT "Loading ";TITL$(THIS): CHAIN MERGE PROG$(THIS),3000,ALL,DELETE 3000-39999 3320 RUN 39999 END 40000 REM ******************************************************* 40020 ' * Miscellaneous Subroutines * 40050 ' * CVTSTR$ -- the name of string being converted * 40060 ' * LENSTR% -- length of string being converted * 40070 ' * CT% -- counter for loops for strings * 40080 ' * being converted * 40090 ' * PAUSE$ -- variable to accept one character * 40100 ' * input for message pause * 40140 ' ******************************************************* 40200 ' *** Remove leading extraneous characters 40210 LET LENSTR%=LEN(CVTSTR$) 40220 IF LENSTR%=0 THEN 40299 40230 IF LEFT$(CVTSTR$,1)<=CHR$(33) THEN CVTSTR$=RIGHT$(CVTSTR$,LENSTR%-1) : GOTO 40210 40299 RETURN 40300 ' *** Remove trailing extraneous characters 40310 LET LENSTR%=LEN(CVTSTR$) 40320 IF LENSTR%=0 THEN 40399 40330 IF RIGHT$(CVTSTR$,1)<=CHR$(33) THEN CVTSTR$=LEFT$(CVTSTR$,LENSTR%-1) : GOTO 40310 40399 RETURN 40400 ' *** Remove extra spaces, tabs, etc within string 40499 ' not yet written 40600 ' *** Convert string to uppercase (CVTSTR$ is argument) 40610 FOR CT%=1 TO LEN(CVTSTR$) 40620 IF ASC(MID$(CVTSTR$,CT%,1)) >96 AND ASC(MID$(CVTSTR$,CT%,1)) < 123 THEN MID$(CVTSTR$,CT%,1) =CHR$(ASC(MID$(CVTSTR$,CT%,1)) -32) 40630 NEXT CT% 40699 RETURN 40700 ' *** Convert string to lowercase (CVTSTR$ is argument) 40710 FOR CT%=1 TO LEN(CVTSTR$) 40720 IF ASC(MID$(CVTSTR$,CT%,1)) >64 AND ASC(MID$(CVTSTR$,CT%,1)) < 91 THEN MID$(CVTSTR$,CT%,1) =CHR$(ASC(MID$(CVTSTR$,CT%,1)) +32) 40730 NEXT CT% 40799 RETURN 40800 ' *** Message pause -- one character input 40810 LET PAUSE$=CHR$(0) 40820 PAUSE$ = INKEY$ 40830 IF PAUSE$ >CHR$(0) THEN 40899 ELSE 40820 40899 RETURN 40900 'Get, strip, & cap 40910 LINE INPUT CVTSTR$ : GOSUB 40200 : GOSUB 40300 : GOSUB 40600 40999 RETURN 41000 'Get, strip, & lowercase 41010 LINE INPUT CVTSTR$ : GOSUB 40200 : GOSUB 40300 : GOSUB 40700 41099 RETURN 43000 REM *** *** 43010 ' *** PARTICULAR PROGRAM SUBROUTINES *** 43020 ' *** *** 43100 ' *** get input strip, cap,check for inst,list, exit 43110 LINE INPUT CVTSTR$ 43120 GOSUB 40200 43130 GOSUB 40300 43140 GOSUB 40600 43199 RETURN 43200 ' ********************************** *** Here we get descriptions *** ********************************** 43210 PRINT CLS$;FNPOSCUR$(10,1);FNCENTER$("This option not yet implemented.") 43220 PRINT FNCENTER$("Hit any key to continue..."); 43230 GOSUB 40800 43240 RUN 43300 ' here we have a number not in the menu bounds 43310 PRINT CLS$;FNPOSCUR$(10,10);"That is not a valid selection ... " 43320 PRINT TAB(10);"Would you like to try again?? (Y/N) ---";BS$;BS$; 43330 GOSUB 40800 : CVTSTR$ = PAUSE$ : GOSUB 40600 : PAUSE$ = CVTSTR$ 43340 IF PAUSE$ = "Y" THEN RUN 43399 GOTO 61000 43500 ' *** Here we set prog$ to program names *** *** and titl$ to loading titles *** 43502 FOR I% = 1 TO 18 43504 IF LEN(PROG$(I%)) = 0 THEN 43530 43510 IF INSTR(PROG$(I%),"MENU") THEN 43530 43520 TITL$(I%) = PROG$(I%): PROG$(I%) = RIGHT$(PROG$(I%),LEN(PROG$(I%))-5) 43530 NEXT I% 43540 RETURN 43599 END 49999 REM *** End of miscellaneous subroutines 50000 REM ******************************************************* 50010 ' * * 50020 ' * Error Processing * 50030 ' * * 50040 ' ******************************************************* 50050 ' *** If no menu 50060 IF ERR=53 AND ERL=60050 THEN RESUME 59100 51000 ' *** *** 51010 ' *** PARTICULAR PROGRAM ERRORS *** 51020 IF ERR = 53 THEN RESUME 52000 ELSE RESUME 59000 52000 ' here we give a message and start over 52010 PRINT CLS$;FNPOSCUR$(10,10);"That is not a valid selection ... " 52020 PRINT TAB(10);"Would you like to try again?? (Y/N) ---";BS$;BS$; 52030 GOSUB 40800 : CVTSTR$ = PAUSE$ : GOSUB 40600 : PAUSE$ = CVTSTR$ 52040 IF PAUSE$ = "Y" THEN RUN 52099 ' end of block 59000 ' *** if not caught by above 59010 PRINT CLS$ 59020 PRINT FNPOSCUR$(12,10);"You just incurred ERROR #";ERR;" at LINE #";ERL 59030 PRINT FNPOSCUR$(18,25);"Press any key to end"; 59040 RESUME 59050 59050 ON ERROR GOTO 50000 59060 ' *** Pause routine 59070 GOSUB 40800 59080 ' *** Return to menu 59090 GOTO 60000 59100 ' *** If no menu then return to system 59110 GOTO 61000 59999 REM *** end of error processing 60000 REM ******************************************************* 60010 ' * * 60020 ' * Program End * 60030 ' * * 60040 ' ******************************************************* 60050 RUN "MENU 61000 'STOP ' development break 61010 SYSTEM 62000 END