home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / MICROCRN / ISSUE_43.ARC / DBMENU.ARC / MAKEMENU.PRG < prev    next >
Encoding:
Text File  |  1988-05-23  |  3.6 KB  |  175 lines
  1. *******************************************************
  2. *** NAME: MAKEMENU.PRG
  3. ***
  4. *** AUTHOR: BRETT FISHBURNE
  5. ***
  6. *** PURPOSE: CREATE A PROGRAM WHICH MAKES A MENU
  7. ***
  8. *******************************************************
  9. PARAMETER Layout, Instruction, Menu
  10.  
  11. *** PREPARE FOR NEW PROGRAM
  12. DELETE FILE TEMP.MNU
  13. SET ALTERNATE TO TEMP.MNU
  14.  
  15. *** ESTABLISH ENVIRONMENT
  16. SET TALK OFF
  17. SET ECHO OFF
  18. SET STATUS OFF
  19. SET SCOREBOARD OFF
  20. SET EXACT ON
  21.  
  22. *** PREPARE THE DATABASES
  23. SELECT 1
  24. USE MENUFILE
  25. SET FILTER TO TRIM(TITLE) = TRIM(MENU)
  26. GOTO TOP
  27. COUNT FOR ELEMENT_TY = 2 TO MAXLETTER
  28. MAXLETTER = CHR(MAXLETTER + 64)
  29. GOTO TOP
  30.  
  31. SELECT 2
  32. USE TILESETS
  33.  
  34. SELECT 1
  35.  
  36. *** GENERATE PROGRAM
  37. SET ALTERNATE ON
  38.  
  39. *** GENERATE TITLE HEADER
  40. ? REPLICATE('*',60)
  41. ? '*** NAME: ' + Menu + '.PRG'
  42. ? '***'
  43. ? '*** AUTHOR: AUTOMATIC MENU GENERATOR (AMG)'
  44. ? '***'
  45. ? '*** PURPOSE: DRAW THE SCREEN FOR THE ' + Menu
  46. ? '***'
  47. ? REPLICATE('*',60)
  48. ?
  49.  
  50. *** GENERATE CONSTANTS
  51. ? '*** INITIALIZE CONSTANTS'
  52. ? "MAXLETTER = '" + MAXLETTER + "'"
  53. ?
  54.  
  55. *** ALLOW THE MENU TO RUN THROUGH ITERATIONS
  56. ? '*** SET UP AN INFINITE LOOP'
  57. ? 'DO WHILE .T.'
  58. ?
  59.  
  60. *** GENERATE STANDARD MENU BOX
  61. ? '*** DRAW BOX'
  62. ? 'CLEAR'
  63. ? '@ 2,0 TO 2,79 DOUBLE'
  64. ? '@ 0,0 TO 21,79 DOUBLE'
  65. ?
  66.  
  67. *** GENERATE HEADER AND FOOTER
  68. ? '*** FILL IN HEADER AND FOOTER'
  69. ? '@ 1,2 SAY "' + SYSTEM + '"'
  70. ? '@ 1,' + STR(40 - INT(LEN(TRIM(TITLE))/2),2) + ' SAY "' +;
  71.   TITLE + '"'
  72. ? '@ 1,55 SAY TIME()'
  73. ? '@ 1,71 SAY DATE()'
  74. ? '@ 22,' + STR(40 - INT(LEN(TRIM(Instruction))/2),2) + ' SAY "';
  75.   + Instruction + '"'
  76. ?
  77.  
  78. *** DETERMINE FORMAT
  79. SELECT 2
  80. GOTO Layout
  81.  
  82. *** GENERATE TILE DESCRIPTORS
  83. ? '*** DRAW TILES'
  84. i = '0'
  85. temp2 = 1
  86. DO WHILE temp2 # 0
  87.  
  88.   temp = TILE&i
  89.   mline&i = VAL(LEFT(temp,2)) + 1
  90.   mhorz&i = VAL(SUBSTR(temp,4,2)) + 2
  91.   
  92.   ? '@ ' + temp
  93.   
  94.   i = STR(VAL(i) + 1)
  95.   IF i = '10'
  96.     EXIT
  97.   ELSE
  98.     i = LTRIM(i)
  99.     temp2 = LEN(TRIM(TILE&I))
  100.   ENDIF
  101.  
  102. ENDDO
  103. ?
  104.  
  105. *** GENERATE OPTIONS AND TITLES FOR TILES
  106. ? '*** PUT OPTIONS AND TITLES IN TILES'
  107. SELECT 1
  108. DO WHILE .NOT. EOF()
  109.  
  110.   temp = STR(TILE,1)
  111.   DO CASE
  112.  
  113.     CASE ELEMENT_TY = 1
  114.       *** TITLE
  115.       ? '@ ' + STR(mline&temp,2) + ',' + STR(mhorz&temp + ELEMENT_NO,2);
  116.         + ' SAY "' + TRIM(ELEMENT) + '"'
  117.       ? '@ ' + STR(mline&temp + 1,2) + ',' + STR(mhorz&temp;
  118.         + ELEMENT_NO,2) + ' SAY REPLICATE("-",' + STR(ELEMENT_SI,2);
  119.         + ')'
  120.       mline&temp = mline&temp + 2
  121.  
  122.     CASE ELEMENT_TY = 2
  123.       *** OPTION
  124.       ? '@ ' + STR(mline&temp,2) + ',' + STR(mhorz&temp,2);
  125.         + ' SAY "' + CHR(64 + ELEMENT_NO) + ' -- ' + TRIM(ELEMENT);
  126.         + '"'
  127.       mline&temp = mline&temp + 1
  128.  
  129.     CASE ELEMENT_TY = 3
  130.       *** CONTINUATION
  131.       ? '@ ' + STR(mline&temp,2) + ',' + STR(mhorz&temp + 5,2);
  132.         + ' SAY "' + TRIM(ELEMENT) + '"'
  133.       mline&temp = mline&temp + 1
  134.  
  135.     CASE ELEMENT_TY = 4
  136.       *** MESSAGE
  137.       ? '@ ' + STR(mline&temp,2) + ',' + STR(mhorz&temp + ; 
  138.         ELEMENT_NO) + ' SAY "' + TRIM(ELEMENT) + '"'
  139.  
  140.   ENDCASE
  141.  
  142.   SKIP
  143. ENDDO
  144. ?
  145.  
  146. *** GENERATE OPTION HANDLER
  147. ? '*** WAIT FOR USER RESPONSE'
  148. ? 'I = 0'
  149. ? 'DO WHILE I = 0'
  150. ? '  @ 1,55 SAY TIME()'
  151. ? '  I = INKEY()'
  152. ? 
  153. ? '  *** CALL USER OPTION'
  154. ? "  IF (UPPER(CHR(I)) >= 'A') .AND. (UPPER(CHR(I)) <= MAXLETTER)"
  155. IF ' ' $ MENU 
  156.   NAME = RTRIM(LEFT(LEFT(MENU,AT(' ',MENU)),7))
  157. ELSE
  158.   NAME = RTRIM(LEFT(MENU,7))
  159. ENDIF
  160. ? "    SUBPROG = '" + NAME + "' + CHR(I)"
  161. ? '    DO &SUBPROG'
  162. ? '  ELSE'
  163. ? '    I = 0'
  164. ? '  ENDIF'
  165. ? 'ENDDO'
  166. ?
  167. ? 'ENDDO'
  168. ?
  169. ? 'RETURN'
  170.  
  171. *** CLEAN UP AFTERWARDS
  172. SET ALTERNATE OFF
  173. SET ALTERNATE TO
  174. CLOSE DATA
  175. RETURN