home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / basic / basictut.ark / MENU.BAS next >
Encoding:
BASIC Source File  |  1985-02-10  |  9.1 KB  |  217 lines
  1. 100    REM >>    Title: MENU.BAS    Version #: 2.0
  2. 110    '    Released to NLS: 01 August, 1983
  3. 120     '       Written for:
  4. 130    '    KAYPRO Corporation
  5. 140    '    Educational Programming Division
  6. 150    '    Solana Beach, CA. 92075
  7. 160    '    By: r. carter, Simple Software, San Diego, CA
  8. 170     '       Copyright (c) 1983, KAYPRO Corporation
  9. 999    'end intro
  10.  
  11.  
  12. 1000      REM *******************************************************
  13. 1020      '   *           Initialization Section                    *
  14. 1040      '   *******************************************************
  15. 1110      '   ***  Standard KAYPRO Program Initializations  ***
  16. 1140   ON ERROR GOTO 50000 '   *** Pointer to Error Processing
  17. 1160   BELL$ = CHR$(7) '   *** Bell character
  18. 1180   CLS$ = CHR$(26) '   *** Clear screen and home 
  19. 1190   BS$ = CHR$(8)
  20. 1200   CR$ = CHR$(13) : LF$ = CHR$(10) '   *** Carriage Return/Line Feed
  21. 1210    CRLF$ = CHR$(13)+CHR$(10)
  22. 1220   DL$ = CHR$(27) + CHR$(82) '   *** Delete Line 
  23. 1240   ELR$ = CHR$(24) '   *** Erase Line Right 
  24. 1260   EES$ = CHR$(23)'   *** Erase to End of Screen 
  25. 1280   EXT$ = CHR$(64) ' the @ sign
  26. 1300   HOME$ = CHR$(30)
  27. 1320   IL$ = CHR$(27) + CHR$(69)'   *** Insert Line
  28. 1340   SW% = 78 :
  29.  
  30.     WIDTH 255
  31. 1360   DEF FNCENTER$(A$) = SPACE$((SW%-LEN(A$))/2) + A$ '   *** Center a String on a line
  32. 1400   DEF FNPOSCUR$(LP%,CP%)=CHR$(27)+"="+CHR$(31+LP%)+CHR$(31+CP%) '   *** Position Cursor
  33. 1500      REM *** PARTICULAR PROGRAM INITIALIZATONS  ***
  34. 1502    DIM PROG$(18),TITL$(18)
  35. 1504    PUSING$ = "        \                       \    \                       \"
  36. 1506    NYSTR$ = "That option is not yet implemented..."
  37. 1510 PROG$(1) = " 1 - TUTR.01"
  38. 1520 PROG$(2) = " 2 - TUTR.02"
  39. 1530 PROG$(3) = " 3 - TUTR.03"
  40. 1540 PROG$(4) = " 4 - TUTR.04"
  41. 1550 PROG$(5) = " 5 - TUTR.05"
  42. 1560 PROG$(6) = " 6 - TUTR.06"
  43. 1570 PROG$(7) = " 7 - TUTR.07"
  44. 1580 PROG$(8) = " 8 - TUTR.08"
  45. 1590 PROG$(9) = " 9 - TUTR.09"
  46. 1600 PROG$(10) = "10 - MENU.10"
  47. 1610 PROG$(11) = "11 - MENU.11"
  48. 1620 PROG$(12) = "12 - TUTR.12"
  49. 1630 PROG$(13) = "13 - TUTR.13"
  50. 1640 PROG$(14) = "14 - TUTR.14"
  51. 1650 PROG$(15) = "15 - MENU.15"
  52. 1660 PROG$(16) = "16 - MENU.16"
  53. 1670 PROG$(17) = "17 - MENU.17"
  54. 1999                REM *** End of initialization
  55. 2000      REM *********************************************************
  56. 2020      '   *                    Title Page                         *
  57. 2040      '   *********************************************************
  58. 2050   PRINT CLS$;
  59. 2060   TITLE$ = "MBASIC TUTOR"
  60. 2070   PRINT FNPOSCUR$(2,1);
  61. 2080   PRINT FNCENTER$(TITLE$)
  62. 2090   PRINT FNCENTER$("A programmed learning experience in programming")
  63. 2300      '   *** Screen credit for non-linear
  64. 2310   PRINT FNPOSCUR$(20,50);"KAYPRO "
  65. 2320   PRINT FNPOSCUR$(21,50);"Educational Programming"
  66. 2340   PRINT FNPOSCUR$(22,50);"Solana Beach, California"
  67. 2350   PRINT FNPOSCUR$(23,50);"(portions copyrighted, 1983)"
  68. 2999      '     *** End of the title page / drop into menu/driver
  69. 3000      '    *******************************
  70.  
  71.         ***  MAIN PROGRAM FOR MENU  ***
  72.  
  73.         *******************************
  74. 3002    GOSUB 43500
  75. 3010    PRINT FNPOSCUR$(4,1)
  76. 3020    FOR I%=1 TO 9
  77. 3030    PRINT USING PUSING$;TITL$(I%),TITL$(I%+9)
  78. 3040    NEXT I%
  79. 3070    PRINT FNPOSCUR$(17,1)"        Press @ to exit to CP/M"
  80. 3080    'PRINT FNPOSCUR$(18,1)"        Press D, followed by the number for a brief description..."
  81. 3090    PRINT FNPOSCUR$(15,1);FNCENTER$("SELECTION --> ");:
  82.  
  83.         GOSUB 43100
  84. 3100 IF LENSTR% = 0 THEN 3090
  85. 3110 IF LEFT$(CVTSTR$,1) = "@" THEN 61000
  86. 3120 IF LEFT$(CVTSTR$,1) = "D" THEN GOSUB 43200:
  87.  
  88.     GOTO 3140
  89. 3130 GOTO 3300
  90. 3140 RUN
  91. 3300 '      **********************************
  92.  
  93.       ***  Here we get programs      ***
  94.  
  95.       **********************************
  96.  
  97.  
  98. 3302 THIS = VAL (CVTSTR$)
  99. 3304 IF THIS < 1 OR THIS > 17 THEN 43300
  100. 3306 PRINT CLS$;FNPOSCUR$(10,25);
  101. 3310 PRINT "Loading ";TITL$(THIS):
  102.  
  103.     CHAIN MERGE PROG$(THIS),3000,ALL,DELETE 3000-39999 
  104. 3320 RUN
  105. 39999 END
  106. 40000     REM *******************************************************
  107. 40020     '   *              Miscellaneous Subroutines              *
  108. 40050     '   *      CVTSTR$ -- the name of string being converted  *
  109. 40060     '   *      LENSTR% -- length of string being converted    *
  110. 40070     '   *      CT%     -- counter for loops for strings       *
  111. 40080     '   *                   being converted                   *
  112. 40090     '   *      PAUSE$  -- variable to accept one character    *
  113. 40100     '   *                   input for message pause           *
  114. 40140     '   *******************************************************
  115. 40200     '   *** Remove leading extraneous characters
  116. 40210  LET LENSTR%=LEN(CVTSTR$)
  117. 40220  IF LENSTR%=0 THEN 40299
  118. 40230  IF LEFT$(CVTSTR$,1)<=CHR$(33) THEN CVTSTR$=RIGHT$(CVTSTR$,LENSTR%-1) :
  119.  
  120.           GOTO 40210
  121. 40299  RETURN
  122. 40300     '   *** Remove trailing extraneous characters
  123. 40310  LET LENSTR%=LEN(CVTSTR$)
  124. 40320  IF LENSTR%=0 THEN 40399
  125. 40330  IF RIGHT$(CVTSTR$,1)<=CHR$(33) THEN CVTSTR$=LEFT$(CVTSTR$,LENSTR%-1) :
  126.  
  127.           GOTO 40310
  128. 40399  RETURN
  129. 40400     '   *** Remove extra spaces, tabs, etc within string
  130. 40499     ' not yet written
  131. 40600     '   *** Convert string to uppercase (CVTSTR$ is argument)
  132. 40610  FOR CT%=1 TO LEN(CVTSTR$)
  133. 40620     IF ASC(MID$(CVTSTR$,CT%,1)) >96 AND ASC(MID$(CVTSTR$,CT%,1)) < 123 
  134.  
  135.            THEN MID$(CVTSTR$,CT%,1) =CHR$(ASC(MID$(CVTSTR$,CT%,1)) -32)
  136. 40630  NEXT CT%
  137. 40699  RETURN
  138. 40700     '   *** Convert string to lowercase (CVTSTR$ is argument)
  139. 40710  FOR CT%=1 TO LEN(CVTSTR$)
  140. 40720     IF ASC(MID$(CVTSTR$,CT%,1)) >64 AND ASC(MID$(CVTSTR$,CT%,1)) < 91 
  141.  
  142.            THEN MID$(CVTSTR$,CT%,1) =CHR$(ASC(MID$(CVTSTR$,CT%,1)) +32)
  143. 40730  NEXT CT%
  144. 40799  RETURN
  145. 40800     '   *** Message pause -- one character input
  146. 40810  LET PAUSE$=CHR$(0)
  147. 40820  PAUSE$ = INKEY$
  148. 40830  IF PAUSE$ >CHR$(0) THEN 40899 ELSE 40820
  149. 40899  RETURN
  150. 40900    'Get, strip, & cap
  151. 40910    LINE INPUT CVTSTR$ : GOSUB 40200 : GOSUB 40300 : GOSUB 40600
  152. 40999    RETURN
  153. 41000    'Get, strip, & lowercase
  154. 41010    LINE INPUT CVTSTR$ : GOSUB 40200 :  GOSUB 40300 : GOSUB 40700
  155. 41099    RETURN
  156. 43000     REM ***                                  ***
  157. 43010     '   ***  PARTICULAR PROGRAM SUBROUTINES  ***
  158. 43020     '   ***                                  ***
  159. 43100     '   *** get input strip, cap,check for inst,list, exit
  160. 43110  LINE INPUT CVTSTR$
  161. 43120  GOSUB 40200
  162. 43130  GOSUB 40300
  163. 43140  GOSUB 40600
  164. 43199  RETURN
  165. 43200 '      **********************************
  166.  
  167.       ***  Here we get descriptions  ***
  168.  
  169.       **********************************
  170.  
  171.  
  172. 43210 PRINT CLS$;FNPOSCUR$(10,1);FNCENTER$("This option not yet implemented.")
  173. 43220 PRINT FNCENTER$("Hit any key to continue...");
  174. 43230 GOSUB 40800
  175. 43240 RUN
  176. 43300 ' here we have a number not in the menu bounds
  177. 43310 PRINT CLS$;FNPOSCUR$(10,10);"That is not a valid selection ... "
  178. 43320 PRINT TAB(10);"Would you like to try again?? (Y/N) ---";BS$;BS$;
  179. 43330 GOSUB 40800 : CVTSTR$ = PAUSE$ : GOSUB 40600 : PAUSE$ = CVTSTR$
  180. 43340 IF PAUSE$ = "Y" THEN RUN
  181. 43399 GOTO 61000
  182. 43500    '    ***  Here we set prog$ to program names ***
  183.  
  184.         ***  and titl$ to loading titles    ***
  185. 43502   FOR I% = 1 TO 18
  186. 43504   IF LEN(PROG$(I%)) = 0 THEN 43530
  187. 43510   IF INSTR(PROG$(I%),"MENU") THEN 43530
  188. 43520    TITL$(I%) = PROG$(I%):
  189.  
  190.         PROG$(I%) = RIGHT$(PROG$(I%),LEN(PROG$(I%))-5)
  191. 43530    NEXT I%
  192. 43540    RETURN
  193. 43599    END
  194. 49999               REM ***  End of miscellaneous subroutines
  195. 50000     REM *******************************************************
  196. 50010     '   *                                                     *
  197. 50020     '   *             Error Processing                        *
  198. 50030     '   *                                                     *
  199. 50040     '   *******************************************************
  200. 50050     '   *** If no menu
  201. 50060  IF ERR=53 AND ERL=60050 THEN RESUME 59100
  202. 51000     '   ***                            ***
  203. 51010     '   ***  PARTICULAR PROGRAM ERRORS ***
  204. 51020    IF ERR = 53 THEN RESUME 52000 ELSE RESUME 59000
  205. 52000 ' here we give a message and start over
  206. 52010 PRINT CLS$;FNPOSCUR$(10,10);"That is not a valid selection ... "
  207. 52020 PRINT TAB(10);"Would you like to try again?? (Y/N) ---";BS$;BS$;
  208. 52030 GOSUB 40800 : CVTSTR$ = PAUSE$ : GOSUB 40600 : PAUSE$ = CVTSTR$
  209. 52040 IF PAUSE$ = "Y" THEN RUN
  210. 52099 ' end of block
  211. 59000     '   *** if not caught by above
  212. 59010  PRINT CLS$
  213. 59020  PRINT FNPOSCUR$(12,10);"You just incurred ERROR #";ERR;" at LINE #";ERL
  214. 59030  PRINT FNPOSCUR$(18,25);"Press any key to end";
  215. 59040  RESUME 59050
  216. 59050  ON ERROR GOTO 50000
  217. 59060     '   *** Pause routine
  218. 59070  GOSUB 40800
  219. 59080     '   *** Return to menu
  220. 59090  GOTO 60000
  221. 59100     '   *** If no menu then return to system
  222. 59110  GOTO 61000
  223. 59999               REM *** end of error processing
  224. 60000     REM *******************************************************
  225. 60010     '   *                                                     *
  226. 60020     '   *           Program End                               *
  227. 60030     '   *                                                     *
  228. 60040     '   *******************************************************
  229. 60050 RUN "MENU
  230. 61000 'STOP ' development break
  231. 61010 SYSTEM
  232. 62000  END
  233. *************************************************
  234. 60050 RUN "MENU
  235. 61000 'STOP ' development break
  236. 6