home *** CD-ROM | disk | FTP | other *** search
/ Software Du Jour / SoftwareDuJour.iso / BUSINESS / DBASE / DBAPG.ARC / MENUGEN.PRG < prev    next >
Text File  |  1984-08-12  |  10KB  |  343 lines
  1. * Program.: MENUGEN.PRG 
  2. * Author..: Luis A. Castro
  3. * Date....: 2/7/83, 7/6/83, 3/30/84
  4. * Notice..: Copyright 1983 & 1984, Luis A. Castro, All Rights Reserved
  5. * Version.: dBASE II, version 2.4x
  6. * Notes...: Generates main menu and submenu command files.
  7. * Local...: choice, extension, outfile, heading, pos,
  8. *           word, item, totalopts, yourname, select,
  9. *           option, col:hdg, expanded, counter, length,
  10. *           col:opts, prompt
  11. *
  12. CLEAR
  13. SET TALK OFF
  14. STORE ".PRG" TO extension
  15. STORE "Your Name" TO yourname
  16. *
  17. * ---Loop through until (S)ave is selected.
  18. STORE " " TO choice
  19. DO WHILE choice <> "S"
  20.    ERASE
  21.    @ 2, 0 SAY "M E N U    G E N E R A T O R"
  22.    @ 2,72 SAY DATE()
  23.    @ 3, 0 SAY "========================================"
  24.    @ 3,40 SAY "========================================"
  25.    * ---Get program name.
  26.    ACCEPT "Enter PROGRAM name " TO outfile
  27.    STORE !( TRIM(outfile) ) + "." TO outfile
  28.    STORE $( outfile, 1, @(".",outfile) - 1 ) TO outfile
  29.    DO CASE
  30.       CASE outfile = " "
  31.          ERASE
  32.          CLEAR
  33.          SET TALK ON
  34.          RETURN
  35.       CASE FILE( outfile + extension )
  36.          STORE "N" TO select
  37.          SET BELL OFF
  38.          @  6,0 SAY "COMMAND FILE ALREADY EXISTS.   "+;
  39.                     "Delete it? [Y/N] ";
  40.                 GET select PICTURE "!"
  41.          READ
  42.          SET BELL ON
  43.          @ $,0 SAY "C"
  44.          IF select <> "Y"
  45.             CLEAR
  46.             SET TALK ON
  47.             RETURN
  48.          ENDIF
  49.    ENDCASE
  50.    STORE outfile + extension TO outfile
  51.    *
  52.    * ---Get MENU heading.
  53.    ACCEPT "Enter MENU heading " TO heading
  54.    IF heading = " "
  55.       CLEAR
  56.       SET TALK ON
  57.       RETURN
  58.    ENDIF
  59.    STORE TRIM( !(heading) ) TO heading
  60.    STORE " " TO expanded
  61.    *
  62.    * ---E X P A N D    h e a d i n g .
  63.    * 
  64.    * -Will NOT correctly expand the heading if more 
  65.    * -than one space separates the words.
  66.    SET EXACT ON
  67.    DO WHILE heading <> " "
  68.       STORE @(" ",heading) TO pos
  69.       IF pos > 0
  70.          STORE $(heading,1,pos-1) TO word
  71.          STORE $( heading, pos+1, LEN(heading) - pos ) TO heading
  72.       ELSE
  73.          STORE heading TO word
  74.          STORE " " TO heading
  75.       ENDIF
  76.       STORE 1 TO counter
  77.       DO WHILE counter <= LEN(word)
  78.          STORE expanded + $( word, counter, 1 ) + " " TO expanded
  79.          STORE counter + 1 TO counter
  80.       ENDDO
  81.       STORE expanded + "   " TO expanded
  82.    ENDDO
  83.    STORE TRIM( expanded ) TO expanded
  84.    STORE $( expanded, 2, LEN( expanded ) ) TO expanded
  85.    STORE ( 80 - LEN( expanded ) ) / 2 TO col:hdg
  86.    SET EXACT OFF
  87.    *
  88.    * ---Enter MENU options.
  89.    ?
  90.    ? "Enter PROGRAM,DESCRIPTION options:"
  91.    ? "   0:exit"
  92.    STORE "exit" to option10
  93.    STORE " " TO program10
  94.    STORE 8 TO length
  95.    *
  96.    * ---Loop through until a carriage return or
  97.    * ---more than 14 options are entered.
  98.    STORE "11" TO item
  99.    STORE "X" TO option&item
  100.    STORE " " TO program&item
  101.    DO WHILE option&item <> " " .AND. VAL( item ) - 10 <= 14
  102.       STORE STR( VAL( item ) - 10, 2 ) TO prompt
  103.       ACCEPT "  &prompt" TO option&item
  104.       STORE TRIM ( option&item ) TO option&item
  105.       IF " " <> option&item 
  106.          STORE @(",",option&item) TO pos
  107.          DO CASE
  108.             CASE pos=0 .OR. (pos=1 .AND. LEN(option&item) > 1)
  109.             * ---A blank program name is assumed.
  110.             CASE pos=1 .OR. pos>9 .OR. pos=LEN(option&item)
  111.             * ---Line was begun with a comma, or program
  112.             * ---name is greater than 8 characters, or
  113.             * ---there is no menu description.
  114.                ? "INVALID ENTRY"
  115.                LOOP
  116.             OTHERWISE
  117.             * ---Get program name.
  118.                STORE TRIM($(option&item,1,pos-1)) TO program&item
  119.          ENDCASE
  120.          STORE $( option&item, pos + 1 ) TO option&item
  121.          IF length < LEN( option&item ) + 4
  122.             STORE LEN( option&item ) + 4 TO length
  123.          ENDIF
  124.          STORE STR( VAL( item ) + 1, 2 ) TO item
  125.          STORE "X" TO option&item
  126.          STORE " " TO program&item
  127.       ENDIF
  128.    ENDDO
  129.    STORE VAL(item)-11 TO totalopts
  130.    IF option11=" "
  131.       CLEAR
  132.       SET TALK ON
  133.       RETURN
  134.    ENDIF
  135.    STORE ( 80 - length ) / 2 TO col:opts
  136.    *
  137.    * ---Redisplay menu frame and heading.
  138.    ERASE
  139.    @ 1, 0 SAY "========================================"
  140.    @ 1,40 SAY "========================================"
  141.    @ 2, 0 SAY "||"
  142.    @ 2,col:hdg SAY expanded
  143.    @ 2,78 SAY "||"
  144.    @ 3, 0 SAY "========================================"
  145.    @ 3,40 SAY "========================================"
  146.    STORE 4 TO counter
  147.    DO WHILE counter <= totalopts + 7
  148.       @  counter,0  SAY "||"
  149.       @  counter,78 SAY "||"
  150.       STORE counter+1 TO counter
  151.    ENDDO
  152.    @ counter, 0 SAY "========================================"
  153.    @ counter,40 SAY "========================================"
  154.    *
  155.    * Display menu options, centered on the screen.
  156.    STORE "10" TO item
  157.    DO WHILE VAL( item ) - 10 <= totalopts
  158.       @ VAL( item ) - 5, col:opts SAY ;
  159.            STR( VAL( item ) - 10, 2 )+ ". " + option&item +;
  160.            " [" + program&item + "]"
  161.       STORE STR( VAL( item ) + 1, 2 ) TO item
  162.    ENDDO
  163.    SET BELL OFF
  164.    STORE " " TO choice
  165.    DO WHILE .NOT. (choice $ "ERS")
  166.       STORE " " TO choice
  167.       @ 22,0  SAY "COMMAND: (E)xit, (R)edo, (S)ave ";
  168.               GET choice PICTURE "!"
  169.       READ
  170.    ENDDO
  171.    SET BELL ON
  172.    IF choice="E"
  173.       CLEAR
  174.       SET TALK ON
  175.       RETURN
  176.    ENDIF
  177. ENDDO while choice <> "S"
  178. *
  179. * ---Generate MENU file.
  180. SET RAW ON
  181. ERASE
  182. SET ALTERNATE TO &outfile
  183. SET ALTERNATE ON
  184. ? [* Program.: ] + outfile
  185. ? [* Author..: ] + yourname
  186. ? [* Date....: ] + DATE()
  187. ? [* Notice..: Copyright 19] + $( DATE(), 7, 2 ) +;
  188.                 [, All Rights Reserved]
  189. ? [* Notes...: ]
  190. ? [* Local...: select, selectnum]
  191. ? [*]
  192. ? [SET TALK OFF]
  193. ? [SET BELL OFF]
  194. ? [SET COLON OFF]
  195. ? 
  196. ? [DO WHILE T]
  197. ? 
  198. ? [ERASE]
  199. ? [@  1, 0 SAY "========================================"]
  200. ? [@  1,40 SAY "========================================"]
  201. ? [@  2, 0 SAY "||"]
  202. ? [@  2,] + STR( col:hdg, 2 ) + [ SAY "] + expanded + ["]
  203. ? [@  2,78 SAY "||"]
  204. ? [@  3, 0 SAY "========================================"]
  205. ? [@  3,40 SAY "========================================"]
  206. *
  207. STORE 4 TO counter
  208. DO WHILE counter <= totalopts + 7
  209.    ? [@ ] + STR( counter, 2 ) + [, 0 SAY "||"]
  210.    ? [@ ] + STR( counter, 2 ) + [,78 SAY "||"]
  211.    STORE counter+1 TO counter
  212. ENDDO
  213. ? [@ ] + STR(counter,2) +;
  214.   [, 0 SAY "========================================"]
  215. ? [@ ] + STR(counter,2) +;
  216.   [,40 SAY "========================================"]
  217. *
  218. STORE "10" TO item
  219. DO WHILE VAL(item)-10 <= totalopts
  220.    ? [@ ]+STR(VAL(item)-5,2)+[,]+STR(col:opts,2)+[ SAY ]+;
  221.      ["]+STR(VAL(item)-10,2)+[. ] + option&item + ["]
  222.    STORE STR(VAL(item)+1,2) TO item
  223. ENDDO
  224. ? [STORE ] + STR( totalopts + 1, 2 ) + [ TO selectnum]
  225. ? [DO WHILE selectnum < 0 .OR. selectnum > ]+STR(totalopts,2)
  226. IF totalopts < 10
  227.    ? [   STORE " " TO select]
  228.    ? [   @ ]+STR(totalopts+8,2)+[,33 SAY " select : : "]
  229.    ? [   @ ]+STR(totalopts+8,2)+[,42 GET select PICTURE "#"]
  230. ELSE
  231.    ? [   STORE "  " TO select]
  232.    ? [   @ ]+STR(totalopts+8,2)+[,33 SAY " select :  : "]
  233.    ? [   @ ]+STR(totalopts+8,2)+[,42 GET select PICTURE "##"]
  234. ENDIF
  235. ? [   READ]
  236. ? [   STORE VAL(select) TO selectnum]
  237. ? [ENDDO]
  238. ?
  239. ? [DO CASE]
  240. ? [   CASE selectnum= 0]
  241. ? [      SET COLON ON]
  242. ? [      SET BELL ON]
  243. ? [      SET TALK ON]
  244. ? [      CLEAR]
  245. ? [      RETURN]
  246. STORE "11" TO item
  247. DO WHILE VAL( item ) - 10 <= totalopts
  248.    ? [   CASE selectnum=] + STR( VAL( item ) - 10, 2 )
  249.    ? [   *  DO ] + option&item
  250.    IF program&item <> " "
  251.       ? [      DO ] + program&item
  252.    ENDIF
  253.    STORE STR(VAL(item)+1,2) TO item
  254. ENDDO
  255. ? [ENDCASE]
  256. ?
  257. ? [ENDDO T]
  258. ? [* EOF: ] + outfile
  259. ?
  260. SET ALTERNATE OFF
  261. SET ALTERNATE TO
  262. *
  263. * ---Generate SUB-MENU programs.
  264. *
  265. STORE "11" TO item
  266. DO WHILE VAL( item ) - 10 <= totalopts
  267.    STORE !( program&item ) + extension TO subfile
  268.    IF program&item = " " .OR. FILE ( subfile ) 
  269.       STORE STR( VAL( item ) + 1, 2 ) TO item
  270.       LOOP
  271.    ENDIF
  272.    STORE !( option&item ) TO heading
  273.    STORE " " TO expanded
  274.    *
  275.    * ---E X P A N D    h e a d i n g .
  276.    * 
  277.    * ---Will NOT correctly expand the heading if more 
  278.    * ---than one space separates the words.
  279.    SET EXACT ON
  280.    DO WHILE heading <> " "
  281.       STORE @(" ",heading) TO pos
  282.       IF pos > 0
  283.          STORE $( heading, 1, pos - 1 ) TO word
  284.          STORE $(heading,pos+1,LEN(heading)-pos) TO heading
  285.       ELSE
  286.          STORE heading TO word
  287.          STORE " " TO heading
  288.       ENDIF
  289.       STORE 1 TO counter
  290.       DO WHILE counter <= LEN( word )
  291.          STORE expanded + $( word, counter, 1 ) + " " TO expanded
  292.          STORE counter + 1 TO counter
  293.       ENDDO
  294.       STORE expanded + "   " TO expanded
  295.    ENDDO
  296.    STORE TRIM( expanded ) TO expanded
  297.    STORE $( expanded, 2, LEN( expanded ) ) TO expanded
  298.    SET EXACT OFF
  299.    *
  300.    * ---Generate SUB-MENU file.
  301.    SET RAW ON
  302.    ERASE
  303.    SET ALTERNATE TO &subfile
  304.    SET ALTERNATE ON
  305.    ? [* Program.: ] + subfile
  306.    ? [* Author..: ] + yourname
  307.    ? [* Date....: ] + DATE()
  308.    ? [* Notice..: Copyright 19] + $( DATE(), 7, 2 ) +;
  309.                    [, All Rights Reserved]
  310.    ? [* Notes...: ]
  311.    ? [*]
  312.    ? [ERASE]
  313.    ? [@  2, 0 SAY "] + expanded + ["]
  314.    ? [@  2,72 SAY DATE()]
  315.    ? [@  3, 0 SAY "========================================"]
  316.    ? [@  3,40 SAY "========================================"]
  317.    ? [STORE " " TO select]
  318.    ? [@ 5,0 SAY "Strike any key to continue... ";]
  319.    ? [      GET select PICTURE "!"]
  320.    ? [READ]
  321.    ? [*]
  322.    ? [RETURN]
  323.    ? [* EOF: ] + subfile
  324.    ?
  325.    SET RAW OFF
  326.    SET ALTERNATE OFF
  327.    SET ALTERNATE TO
  328.    STORE STR( VAL( item ) + 1, 2 ) TO item
  329. ENDDO
  330. *
  331. ERASE
  332. STORE $( outfile, 1, @(".",outfile) - 1 ) TO outfile
  333. ? [TO START "] + outfile + [" MAIN MENU, TYPE THE FOLLOWING:]
  334. ? [.]
  335. ? [. DO ]+outfile
  336. ? [.]
  337. ? [.]
  338. CLEAR
  339. SET TALK ON
  340. SET RAW OFF
  341. RETURN
  342. * EOF: MENUGEN.PRG
  343.