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