home *** CD-ROM | disk | FTP | other *** search
/ Share Gallery 1 / share_gal_1.zip / share_gal_1 / LA / LA015.ZIP / DG_PROC.PRG < prev    next >
Text File  |  1985-08-15  |  55KB  |  1,889 lines
  1. * Program..: dGENERATE
  2. * Filename.: dg_proc.prg
  3. * Author...: Tom Rettig
  4. * Dates....: 3/28/84, 8/30/84, 12/29/84, 12/30/84, 12/31/84, 1/01/85,
  5. *            1/03/85, 1/04/85,  1/05/85,  1/06/85,  1/11/85, 1/12/85,
  6. *            1/13/85, 1/15/85,  1/25/85,  1/26/85,  1/27/85, 1/28/85,
  7. *            1/29/85, 1/30/85,  2/01/85,  2/09/85,  2/10/85, 2/12/85,
  8. *            2/13/85, 2/16/85,  2/17/85,  2/18/85,  2/19/85, 2/22/85,
  9. *            2/23/85, 2/24/85,  2/25/85,  3/17/85,  4/01/85, 6/01/85,
  10. *            6/26/85, 6/27/85,  7/01/85,  7/25/85,  7/27/85, 8/15/85
  11. * Notice...: Copyright 1985, Tom Rettig & Associates, All Rights Reserved.
  12. * Version..: 1.0 (x30)
  13. * Run under: dBASE III, any version greater than 1.1, or dBRUN.
  14. * Notes....: To generate executable dBASE code from screen-forms
  15. *            and database files.
  16. *
  17. * Called from...: dg_main.prg
  18. *
  19. * Files required: dg_main.prg --> Program entry and main menu
  20. *                 dg.dbf      --> Structure for database: dg.dbf
  21. *                                 Field  Field Name  Type       Width
  22. *                                     1  DG_TEXT     Character    254
  23. *                                 ** Total **                     255
  24. *
  25. * Procedures are in alphabetical order:
  26. *         dg_main  ::= entry/exit from dGENERATE and main menu
  27. *      1  abort    ::= aborts code generation and returns to main menu
  28. *      2  alt_file ::= opens/closes alternate file and writes header/footer
  29. *      3  config   ::= initializes system values from parameters line
  30. *      4  crea_new ::= creates a new screen-form for drawing
  31. *      5  doer     ::= executes a command file
  32. *      6  editor   ::= edits a screen-form or any text file
  33. *      7  file_msg ::= displays source and target filenames
  34. *      8  fileprmt ::= prompts for a filename and tests for existence
  35. *      9  generate ::= reads a screen-form and causes code to be written
  36. *     10  gen_entr ::= writes code for data entry/edit algorithm
  37. *     11  gen_menu ::= writes code for menu algorithm
  38. *     12  gen_rprt ::= writes code for report algorithm
  39. *     13  helper   ::= main help file
  40. *     14  hlp_crea ::= help screen for crea_new
  41. *     15  hlp_doer ::= help screen for doer
  42. *     16  hlp_edit ::= help screen for edit
  43. *     17  hlp_gene ::= help screen for generate
  44. *     18  hlp_mgen ::= help screen for mem_gen
  45. *     19  hlp_setu ::= help screen for setup
  46. *     20  hlp_togl ::= toggles between pages in multi-page hlp_* screens
  47. *     21  key_time ::= displays continuous time while waiting for keypress
  48. *     22  line_inc ::= increments line counter and tests for new page
  49. *     23  marquee  ::= places this program's headings on screen
  50. *     24  mem_gen  ::= writes memvar statements from database file
  51. *     25  pars_lit ::= parses literal strings for write
  52. *     26  pars_var ::= parses variables for write
  53. *     27  setup    ::= menu driven edit of the default parameters
  54. *     28  set_if1  ::= setup options -|
  55. *     29  set_if2  ::= setup options -|---(broken up for performance)
  56. *     30  set_if3  ::= setup options -|
  57. *     31  wait_msg ::= handles 'be patient' message, and sets up abort
  58. *     32  write    ::= writes code from parsed literals or variables
  59. *
  60. * Macro is used in the syntax of these commands:
  61. *         APPEND FROM, DIR, DO, ERASE, MODIFY COMMAND, RUN, USE
  62. *         SET ALTERNATE, SET COLOR, SET DELIMITERS
  63.  
  64.  
  65. PROCEDURE abort
  66. PARAMETERS dl_wrkfile
  67. * Called from crea_new, generate, mem_gen
  68. ON ESCAPE *
  69. SET COLOR TO &dg_accent
  70. SET BELL ON
  71. @ 22,0 SAY "                          Aborting this procedure!!!" +;
  72.            "                           "
  73. ?? CHR(7), CHR(7)
  74. @ 23,0 SAY "                    One moment, please, while I clean up..." +;
  75.            "                    "
  76. SET COLOR TO &dg_normal
  77. SET BELL OFF
  78. *
  79. CLOSE ALTERNATE
  80. IF FILE(dl_wrkfile)
  81.    ERASE &dl_wrkfile
  82. ENDIF
  83. *
  84. CLOSE INDEXES
  85. IF FILE("Dg_temp$.ndx")
  86.    ERASE Dg_temp$.ndx
  87. ENDIF
  88. *
  89. * This is possible only from generate where 'dg_param' is reinitialized.
  90. * (unless crea_new or mem_gen are told to use dg.dbf)
  91. IF "DG.DBF" $ UPPER(DBF())
  92.    SET SAFETY OFF
  93.    ZAP
  94.    SET SAFETY ON
  95.    IF [] < dl_oldt
  96.       APPEND BLANK
  97.       REPLACE Dg_text WITH dl_oldt
  98.       DO config WITH dl_oldt
  99.    ENDIF
  100. ENDIF
  101. *
  102. USE
  103. *
  104. IF FILE("Dg_temp$.dbf")
  105.    ERASE Dg_temp$.dbf
  106. ENDIF
  107. *
  108. ON ESCAPE SUSPEND
  109. RETURN TO MASTER
  110. *
  111. * EOP abort **********************************************************
  112.  
  113.  
  114. PROCEDURE alt_file
  115. * Called from generate and mem_gen, not from crea_new
  116. PARAMETERS dl_targetf, dl_part
  117. *
  118. IF dl_part = 1
  119.    * Open target file, and write its name and system date as a header.
  120.    @ 3,0 SAY []
  121.    SET ALTERNATE TO &dl_targetf
  122.    SET ALTERNATE ON
  123.    ?? "* Program..: " + dl_targetf
  124.    ?  "* Author...: <name>" 
  125.    ?  "* Date.....: " + DTOC(DATE())
  126.    ?  "* Notice...: Copyright " + STR(YEAR(DATE()),4) +;
  127.                               ", <name>, All Rights Reserved."
  128.    ?  "* Notes....: "
  129.    ?  "*"
  130.    ?
  131. ELSE
  132.    * Write footer and close the file.
  133.    ??  "* EOF: " + dl_targetf
  134.    CLOSE ALTERNATE
  135. ENDIF
  136. *
  137. RETURN
  138. * EOP alt_file *******************************************************
  139.  
  140.  
  141. PROCEDURE config
  142. * Called from default, generate, setup
  143. PARAMETERS dl_linef
  144. *
  145.  * Characters used to denote SAYs and GETs in the screen-form.
  146. dg_atget   = SUBSTR(dl_linef,13,1) 
  147. dg_atsay   = SUBSTR(dl_linef,15,1) 
  148.  * Character used to denote a memvar initialization in the screen-form.
  149. dg_init    = SUBSTR(dl_linef,17,1)
  150.  * Number of columns on the screen (1..254).
  151. dg_eol     = VAL(SUBSTR(dl_linef,19,3))   && end of line
  152.  * Number of lines (rows) on the screen (1..999).
  153. dg_eos     = VAL(SUBSTR(dl_linef,23,3))   && end of screen
  154.  * Logicals.
  155. dg_isreltv = SUBSTR(dl_linef,27,1) = [T]  && relative addressing in code
  156. dg_isruler = SUBSTR(dl_linef,29,1) = [T]  && ruler line in screen-form
  157. dg_isdelim = SUBSTR(dl_linef,31,1) = [T]  && set delimiters on
  158. dg_isfill  = SUBSTR(dl_linef,33,1) = [T]  && fill screen-form with blanks
  159. dg_ishelp  = SUBSTR(dl_linef,35,1) = [T]  && help screens for each menu item
  160.  * Default file extensions.
  161. dg_fmemout = SUBSTR(dl_linef,37,3)   && output file for creating memvars
  162. dg_fscrout = SUBSTR(dl_linef,41,3)   && output file for code from screen-form
  163. dg_fscr_in = SUBSTR(dl_linef,45,3)   && screen-form file for drawing screens
  164.  * Characters in ruler.
  165. dg_rule1   = SUBSTR(dl_linef,49,1)   && appears in column zero only
  166. dg_rule    = SUBSTR(dl_linef,51,10)  && repeats every ten columns after zero
  167.  * Delimiters.
  168. dg_delim   = SUBSTR(dl_linef,62,2)   && characters used for delimiters
  169.  * Character used in this menu (ASCII value).
  170. dg_char    = VAL(SUBSTR(dl_linef,65,3))  && used in marquee of this program
  171.  * Word processor. 
  172. dg_wp      = SUBSTR(dl_linef,69,8)       && external editor for screen-forms
  173. *
  174. * Program constants.
  175. dg_line    = REPLICATE(CHR(dg_char),80)  && marquee line in this program
  176. dg_ruler   = dg_rule1 + REPLICATE(dg_rule,INT((dg_eol-1)/10)) +;
  177.                LEFT(dg_rule,MOD(dg_eol-1,10))  && ruler line in screen-forms
  178. dg_max     = IIF(dg_eol < 100, 2, 3)    && number of digits in @ coordinates
  179. *
  180. * Set the delimiters.
  181. IF dg_isdelim .AND. dg_delim > [ ]
  182.    SET DELIMITERS TO [&dg_delim]
  183.    SET DELIMITERS ON
  184. ELSE
  185.    SET DELIMITERS OFF
  186. ENDIF
  187. *
  188. * Convert logicals to character.
  189. dl_1 = IIF(dg_isreltv, "T", "F")
  190. dl_2 = IIF(dg_isruler, "T", "F")
  191. dl_3 = IIF(dg_isdelim, "T", "F")
  192. dl_4 = IIF(dg_isfill , "T", "F")
  193. dl_5 = IIF(dg_ishelp , "T", "F")
  194. *
  195. * Construct a new parameters line from individual memvars.
  196. dl = [ ]
  197. dg_param = [parameters: ]+dg_atget+dl+dg_atsay+dl+dg_init+dl+;
  198.   STR(dg_eol,3)+dl+STR(dg_eos,3)+dl+dl_1+dl+dl_2+dl+dl_3+dl+dl_4+dl+dl_5+dl+;
  199.   dg_fmemout+dl+dg_fscrout+dl+dg_fscr_in+dl+dg_rule1+dl+dg_rule+dl+;
  200.   dg_delim+dl+STR(dg_char,3)+dl+dg_wp
  201. *
  202. RETURN
  203. * EOP config *********************************************************
  204.  
  205.  
  206. PROCEDURE crea_new
  207. * Called from menu
  208. * To initialize a text file for drawing screens.
  209. *
  210. DO marquee WITH [ Creating a New Screen ]
  211. *
  212. IF dg_ishelp
  213.    DO helper WITH 1
  214. ENDIF
  215. *
  216. * Prompt for name of target text file.
  217. dl_targetf = [ ]
  218. dl_defext  = dg_fscr_in
  219. dl_istargt = .T.
  220. dl_isedit  = .F.
  221. DO fileprmt
  222. IF dg_iserror
  223.    RETURN
  224. ENDIF
  225. *
  226. * Prompt for name of source database file if any.
  227. dl_sourcef = []
  228. dl_names   = [?]
  229. SET COLOR TO &dg_accent
  230. *
  231. @ 11,13 SAY "Add field and memvar names from a database file? (Y/N)" ;
  232.         GET dl_names
  233. IF dg_ishelp
  234.    @ 13,08 SAY "Memory variable names are generated from "+;
  235.                "this file's field names,"
  236.    @ 14,14 SAY "and both are placed in the screen-form for your use."
  237. ENDIF
  238. *
  239. READ
  240. @ 11,13
  241. @ 13,08
  242. @ 14,14
  243. SET COLOR TO &dg_normal
  244. IF dl_names $ "Yy"
  245.    dl_defext  = [dbf]
  246.    STORE .F. TO dl_istargt, dl_isedit
  247.    DO fileprmt
  248.    IF dg_iserror
  249.       RETURN
  250.    ENDIF
  251. ENDIF
  252. *
  253. dl_abortf = dl_targetf
  254. DO wait_msg WITH 1
  255. DO file_msg WITH dl_sourcef, dl_targetf
  256. * returns with color set to dg_accent.
  257. *
  258. * Open target file, and write.
  259. SET CONSOLE OFF
  260. SET ALTERNATE TO &dl_targetf
  261. SET ALTERNATE ON
  262. *
  263. * Write the top (ruler) line.
  264. IF dg_isruler
  265.    ?? dg_ruler
  266. ENDIF
  267. *
  268. * Write the screen body.
  269. dl_i = 1
  270. IF dg_isfill
  271.    DO WHILE dl_i <= dg_eos
  272.       ? SPACE(dg_eol)
  273.       dl_i = dl_i+1
  274.    ENDDO
  275. ELSE
  276.    DO WHILE dl_i <= dg_eos
  277.       ?
  278.       dl_i = dl_i+1
  279.    ENDDO
  280. ENDIF
  281. *
  282. * Add parameters, date, and definition table lines.
  283. ?
  284. ? "dgDEFINE -- Begin definitions in the first column.  Example syntax follows:"
  285. ? "<definition symbol> [<memvar> " + dg_init + ;
  286.                                  "] <expression> [PICTURE/FUNCTION <template>]"
  287. IF [] < dl_sourcef   && add memvars initialized from file if requested
  288.    dl_oldt = []         && for abort if dg.dbf is specified
  289.    USE &dl_sourcef
  290.    dl_i = 1
  291.    DO WHILE [] < FIELD(dl_i)
  292.       ? [  m_] + LOWER(SUBSTR(FIELD(dl_i),1,8)) + [ ] + dg_init + [ ] +;
  293.                  SUBSTR(FIELD(dl_i),1,1) + LOWER(SUBSTR(FIELD(dl_i),2))
  294.       dl_i = dl_i+1
  295.    ENDDO
  296.    * Add file opening statement.
  297.    ?
  298.    ? [dgFILE], dl_sourcef
  299.    USE
  300. ENDIF
  301. ?
  302. ?
  303. ? "Begin options in the first column, one per line."
  304. ? "Code generating options are: dgENTRY, dgMENU, and dgREPORT, one per screen."
  305. ? "File opening option is: dgFILE <database filename>, one per screen."
  306. ?
  307. ?
  308. ? LEFT(dg_param,29) + [                       ] + DTOC(DATE())
  309. ? "            | | | |   |   | |"
  310. ? " GET Symbol-' | | |   |   | `-Ruler line (T/F)"
  311. ? " SAY Symbol---' | |   |   `---Relative Addressing (T/F)"
  312. ? " Initialization | |   `-------Form Length (rows: 1..999)"
  313. ? "         Symbol-' `-----------Form Width (columns: 1..254)"
  314. *
  315. CLOSE ALTERNATE
  316. ON ESCAPE SUSPEND
  317. SET CONSOLE ON
  318. SET COLOR TO &dg_normal
  319. *
  320. * Automatic edit with this target filename if editor is
  321. * not memory-resident.
  322. IF UPPER(dg_wp) # "INMEMORY"
  323.    DO editor WITH dl_targetf
  324. ENDIF
  325. *
  326. RETURN
  327. * EOP crea_new *******************************************************
  328.  
  329.  
  330. PROCEDURE doer
  331. * Called from menu and generate
  332. PARAMETERS dl_fname
  333. *
  334. DO marquee WITH [  DOing a Command File ]
  335. *
  336. * Branch for call from menu
  337. IF [] = dl_fname
  338.    IF dg_ishelp
  339.       DO helper WITH 5
  340.    ENDIF
  341.    *
  342.    * Prompt for name of command file.
  343.    dl_sourcef = [ ]
  344.    dl_defext  = dg_fscrout
  345.    STORE .F. TO dl_istargt, dl_isedit
  346.    DO fileprmt
  347.    IF dg_iserror
  348.       RETURN
  349.    ENDIF
  350.    dl_fname = dl_sourcef
  351. ENDIF
  352. *
  353. * Do nothing about errors in DO file so they can be observed.
  354. CLEAR
  355. DO &dl_fname
  356. *
  357. RETURN
  358. * EOP doer *********************************************************
  359.  
  360.  
  361. PROCEDURE editor
  362. * Called from menu and create
  363. PARAMETERS dl_finame
  364. *
  365. DO marquee WITH [ Editing a Screen-Form ]
  366. *
  367. IF dg_ishelp
  368.    DO helper WITH 2
  369. ENDIF
  370. *
  371. * Branch for call from menu
  372. IF [] = dl_finame
  373.    *
  374.    * Prompt for name of source text file.
  375.    dl_sourcef = [ ]
  376.    dl_defext  = dg_fscr_in
  377.    dl_istargt = .F.
  378.    dl_isedit  = .T.
  379.    DO fileprmt
  380.    IF dg_iserror
  381.       RETURN
  382.    ENDIF
  383.    dl_finame = dl_sourcef
  384. ENDIF
  385. *
  386. DO file_msg WITH dl_finame, []
  387. SET COLOR TO &dg_normal
  388. *
  389. * No way to check for existence of word processor file where DOS 
  390. * path is set to its location in another directory.  Only solution
  391. * is to set WP in Config.db and use MODI COMM.
  392. IF dg_wp > [        ] .AND. UPPER(dg_wp) # "INMEMORY"
  393.    RUN &dg_wp &dl_finame
  394.    SET COLOR TO &dg_normal
  395. ELSE
  396.    MODIFY COMMAND &dl_finame
  397. ENDIF
  398. *
  399. * Automatic generation of edited file if
  400. * extension is screen-form and file exists.
  401. IF RIGHT(dl_finame,3) = dg_fscr_in .AND. FILE(dl_finame)
  402.    DO generate WITH dl_finame
  403. ENDIF
  404. *
  405. RETURN
  406. * EOP editor *********************************************************
  407.  
  408.  
  409. PROCEDURE file_msg
  410. PARAMETERS dl_sfile, dl_tfile
  411. * Called from crea_new, editor, generate, mem_gen
  412. * Sets color to dg_accent on return.
  413. @ 23,11 SAY IIF([] < dl_tfile, ;
  414.                 "Source file:               >>>  Target file: ",;
  415.                 "Source file:")
  416. SET COLOR TO &dg_accent
  417. @ 23,24 SAY IIF([] = dl_sfile, "<none>", dl_sfile)
  418. @ 23,56 SAY dl_tfile
  419. *
  420. RETURN
  421. * EOP file_msg *******************************************************
  422.  
  423.  
  424. PROCEDURE fileprmt
  425. * Called from crea_new, doer, editor, generate, mem_gen
  426. * To prompt for filenames, input & output with different default extensions.
  427. * dl_defext, dl_istargt, dl_isedit are initialized in calling routine.
  428. * If dl_isedit, then it's ok for source file not to exist.
  429. *
  430. * Display files of the appropriate type.
  431. * (file types are screen-form, executable, or database)
  432. * System extensions (dg_f...) must be initialized in calling routine.
  433. @ 4,0 SAY "Existing " + IIF(dl_defext=dg_fscr_in .OR. dl_defext=dg_fscrout,;
  434.           IIF(dl_defext=dg_fscr_in,"screen-form","executable"),"database")+;
  435.           " files in the current directory are:"
  436. @ 5,0 SAY []
  437. IF "UNIX" $ OS()
  438.    DIR ALL *.&dl_defext
  439. ELSE
  440.    DIR *.&dl_defext
  441. ENDIF
  442. *
  443. * Returns true if operator chooses to abort.
  444. dg_iserror = .F.
  445. *
  446. DO WHILE .T.
  447.    dl_n = [        .] + dl_defext
  448.    SET COLOR TO &dg_accent
  449.    @ 17,10 SAY "Enter " + IIF(dl_istargt, "target", "source") +;
  450.                " filename, or press " + dg_key + " to abort:" 
  451.    @ 17,COL()+1 GET dl_n PICTURE [AXXXXXXXXXXX]
  452.    READ
  453.    *
  454.    * Clear re-enter prompt, if any.
  455.    @ 22,17
  456.    @ 23,13
  457.    *
  458.    DO CASE
  459.       CASE dl_n = [        .] + dl_defext .OR. LTRIM(dl_n) = [.] .OR.;
  460.            [] = TRIM(dl_n)
  461.          * Abort.
  462.          dg_iserror = .T.
  463.          SET COLOR TO &dg_normal
  464.          @ 17,10
  465.          RETURN
  466.       CASE "DOS"$OS() .AND. ( "["$dl_n .OR. "]"$dl_n .OR. "^"$dl_n .OR.;
  467.            "*"$dl_n .OR. "+"$dl_n .OR. "="$dl_n .OR. ";"$dl_n .OR.;
  468.            "<"$dl_n .OR. ">"$dl_n .OR. ","$dl_n .OR. "?"$dl_n .OR.;
  469.            "|"$dl_n .OR. "\"$dl_n .OR. "/"$dl_n )
  470.          * Invalid entry.
  471.          @ 23,18 SAY "Invalid filename, please re-enter or abort..."
  472.          LOOP
  473.       CASE "." $ dl_n
  474.          * Trim the name and place next to the extension.
  475.          dl_n = LTRIM(RTRIM( SUBSTR(dl_n,1,AT(".",dl_n)-1) )) +;
  476.                              SUBSTR(dl_n,AT(".",dl_n),4) 
  477.       OTHERWISE
  478.         * Trim the name and add the default extension.
  479.         dl_n = IIF(LEN(LTRIM(RTRIM(dl_n))) > 8,;
  480.                    SUBSTR(LTRIM(RTRIM(dl_n)),1,8),;
  481.                    LTRIM(RTRIM(dl_n)) ) + [.] + dl_defext
  482.    ENDCASE
  483.    *
  484.    * Branch for space in filename.  Space is allowed in CASE statement
  485.    * above in order to allow for spaces between the name and extension.
  486.    IF [ ] $ dl_n
  487.       @ 23,18 SAY "Invalid filename, please re-enter or abort..."
  488.       LOOP
  489.    ENDIF
  490.    *
  491.    SET COLOR TO &dg_normal
  492.    *
  493.    IF dl_istargt
  494.       * It's a target file.
  495.       *
  496.       IF FILE(dl_n)
  497.          SET COLOR TO &dg_accent
  498.          @ 22,(54-LEN(dl_n))/2 SAY dl_n + " exists where I'm looking."
  499.          @ 23,13 SAY "Press <W> to overWrite, or any other key to re-enter..."
  500.          SET COLOR TO &dg_normal
  501.          dl_i = 0
  502.          DO key_time WITH COL()
  503.          IF CHR(dl_i) $ "wW"
  504.             dl_targetf = dl_n
  505.             EXIT
  506.          ELSE
  507.             @ 17,10
  508.             @ 22,21
  509.             @ 23,13
  510.             LOOP
  511.          ENDIF
  512.       ELSE
  513.          dl_targetf = dl_n
  514.          EXIT
  515.       ENDIF
  516.    ELSE
  517.       * It's a source file.
  518.       *
  519.       IF FILE(dl_n) .OR. dl_isedit
  520.          * It's ok for the dl_sourcef to not exist when coming from editor.
  521.          dl_sourcef = dl_n
  522.          SET COLOR TO &dg_normal
  523.          EXIT
  524.       ELSE
  525.          SET COLOR TO &dg_accent
  526.          @ 22,(47-LEN(dl_n))/2 ;
  527.            SAY dl_n + " doesn't exist where I'm looking."
  528.          @ 23,13 ;
  529.            SAY "Please enter a different source filename, or abort..."
  530.       ENDIF [FILE(dl_n) .OR. dl_isedit]
  531.    ENDIF [dl_istargt]
  532. ENDDO [WHILE .T.]
  533. *
  534. * Clear screen body and repaint bottom screen line before returning.
  535. SET COLOR TO &dg_normal
  536. @  3,0 CLEAR
  537. @ 21,0 SAY dg_line
  538. RETURN
  539. *
  540. * EOP fileprmt *******************************************************
  541.  
  542.  
  543. PROCEDURE generate
  544. * Called from menu and editor
  545. PARAMETERS dl_filname
  546. * Variable 'dl_filname' is used as the source file in this module.
  547. *
  548. DO marquee WITH [  Generating Commands  ]
  549. *
  550. * Branch for call from menu.
  551. IF [] = dl_filname
  552.    IF dg_ishelp
  553.       DO helper WITH 3
  554.    ENDIF
  555.    *
  556.    * Prompt for name of source text file.
  557.    dl_sourcef = [ ]
  558.    dl_defext  = dg_fscr_in
  559.    STORE .F. TO dl_istargt, dl_isedit
  560.    DO fileprmt
  561.    IF dg_iserror
  562.       RETURN
  563.    ENDIF
  564.    dl_filname = dl_sourcef
  565. ENDIF
  566. *
  567. * Target filename is automatic from source file.
  568. STORE SUBSTR(dl_filname,1,AT(".",dl_filname)) + dg_fscrout ;
  569.       TO dl_tfile, dl_abortf
  570. *
  571. * Open system database file, and preserve the parameters line if any.
  572. USE dg
  573. dl_oldt = IIF(RECCOUNT() > 0 .AND. Dg_text = "parameters: ",;
  574.               TRIM(Dg_text), [] )
  575. *
  576. DO wait_msg WITH 1
  577. DO file_msg WITH dl_filname, dl_tfile
  578. *
  579. SET SAFETY OFF
  580. ZAP
  581. *
  582. * Bring source text file into database file, and index.
  583. APPEND FROM &dl_filname SDF
  584. INDEX ON LEFT(Dg_text,13) TO Dg_temp$.ndx
  585. *
  586. SET SAFETY ON
  587. *
  588. * Read parameters line of file, and set everything accordingly.
  589. SEEK "parameters: "
  590. *
  591. * Parameter test is different from one in main.
  592. dl_isdiffp = .F.
  593. IF FOUND() .AND. SUBSTR(Dg_text,27,1) $ [TF] .AND.;
  594.                  SUBSTR(Dg_text,29,1) $ [TF] .AND.;
  595.                  SUBSTR(Dg_text,13,1) # SUBSTR(Dg_text,15,1)
  596.    * Branch if parameters in file do not equal current system parameters.
  597.    IF LEFT(dg_param,29) # LEFT(Dg_text,29)
  598.       dl_isdiffp = .T.
  599.       dl_oldp    = dg_param   && save the current parameters
  600.       DO config WITH LEFT(Dg_text,29) + SUBSTR(dg_param,30)
  601.    ENDIF
  602. ELSE
  603.    SET COLOR TO &dg_normal
  604.    @ 22,1 SAY "Parameters line in Source file is not valid; " +;
  605.               "current system values being used."
  606.    SET COLOR TO &dg_accent
  607. ENDIF
  608. *
  609. * Clear waiting message, open target file, and write its header.
  610. DO wait_msg WITH 2
  611. DO alt_file WITH dl_tfile, 1
  612. *
  613. * Establish offset between top of file and row zero.
  614. * (top of screen ::= dl_offset; end of screen ::= dg_eos + dl_offset)
  615. dl_offset = IIF(dg_isruler,2,1)
  616. *
  617. * If any says or gets are in the screen, prepare for the 
  618. * case where one is undefined or unitialized.
  619. SET ORDER TO 0
  620. GO dl_offset   && top of screen
  621. LOCATE WHILE RECNO() < dg_eos + dl_offset;
  622.        FOR (dg_atget $ Dg_text .OR. dg_atsay $ Dg_text) .AND.;
  623.            Dg_text # "parameters: " .AND. Dg_text # "<definition "
  624. IF FOUND()
  625.    DO line_inc
  626.    ?? [undefined  = "***"]
  627.    DO line_inc
  628. ENDIF
  629. *
  630. * Write the file-opening command if there is one.
  631. SET ORDER TO 1
  632. SEEK [dgFILE ]
  633. dl_isfile = FOUND()
  634. IF FOUND()
  635.    DO line_inc
  636.    DO line_inc
  637.    ?? [USE ] + LTRIM(RTRIM(SUBSTR(Dg_text,AT(" ",Dg_text))))
  638.    DO line_inc
  639. ENDIF
  640. *
  641. * Write the initialized memvar statements.
  642. SEEK [dgDEFINE]
  643. IF FOUND()
  644.    SET ORDER TO 0
  645.    SKIP 2
  646.    DO WHILE [] < TRIM(Dg_text) .AND. .NOT. EOF()
  647.       IF dg_init $ Dg_text
  648.          dl_phrase = LTRIM(RTRIM(SUBSTR(Dg_text,AT(dg_init,Dg_text)+1)))
  649.          dl_loc = IIF(" PICT"$UPPER(dl_phrase),AT(" PICT",UPPER(dl_phrase)),;
  650.                                                AT(" FUNC",UPPER(dl_phrase)))
  651.          dl_exp = IIF(dl_loc>0, TRIM(LEFT(dl_phrase,dl_loc)), dl_phrase)
  652.          dl_var = LTRIM(SUBSTR(Dg_text,3,AT(" ",LTRIM(SUBSTR(Dg_text,3)))))
  653.          *
  654.          DO line_inc
  655.          ?? dl_var + SPACE(11-LEN(dl_var)) + [= ] +;
  656.                      IIF(TYPE("dl_exp")="U",[undefined],dl_exp)
  657.       ENDIF
  658.       SKIP
  659.    ENDDO
  660.    DO line_inc
  661.    SET ORDER TO 1
  662. ENDIF
  663. *
  664. * Write the delimiters code if requested.
  665. IF dg_isdelim
  666.    DO line_inc
  667.    ?? [SET DELIMITERS TO ] + dg_delim
  668.    DO line_inc
  669. ENDIF
  670. *
  671. * Write part one of the requested optional code.
  672. STORE .F. TO dl_isentry, dl_ismenu, dl_isreprt
  673. SEEK [dgENTRY ]
  674. IF FOUND()
  675.    dl_isentry = .T.
  676.    DO gen_entr WITH 1
  677. ELSE
  678.    SEEK [dgMENU ]
  679.    IF FOUND()
  680.       dl_ismenu  = .T.
  681.       dl_menupos = RECNO()
  682.       DO gen_menu WITH 1     && sets ORDER to 0
  683.    ELSE
  684.       SEEK [dgREPORT ]
  685.       IF FOUND()
  686.          dl_isreprt = .T.
  687.          DO gen_rprt WITH 1
  688.       ENDIF [report]
  689.    ENDIF [menu]
  690. ENDIF [entry]
  691. *
  692. * Write the beginning relative positioning statement.
  693. dl_lastrow = 0
  694. IF dg_isreltv
  695.    DO line_inc
  696.    ?? [@ ] + STR(dl_lastrow,dg_max) + [,] + STR(dl_lastrow,dg_max) +;
  697.       [ SAY ""]
  698. ENDIF
  699. *
  700. * Parse each line on the screen, and write the output code.
  701. SET ORDER TO 0 
  702. GO dl_offset     && top of screen
  703. DO WHILE RECNO() < dg_eos+dl_offset .AND. .NOT. EOF()
  704.    IF [] < TRIM(Dg_text)
  705.       dl_atrow = RECNO() - dl_offset
  706.       dl_line  = LEFT(Dg_text,dg_eol)
  707.       * 'dl_i' is a pointer to individual characters in 'dl_line'.
  708.       * Point to first character, skipping any spaces.
  709.       dl_i = AT(LTRIM(dl_line), dl_line)
  710.       DO WHILE dl_i <= dg_eol
  711.          dl_str = SUBSTR(dl_line, dl_i)
  712.          IF dl_str = dg_atsay .OR. dl_str = dg_atget
  713.             * Process it as a variable.
  714.             DO pars_var
  715.             * Reposition record pointer which is moved to search for defines.
  716.             GO dl_atrow + dl_offset
  717.          ELSE
  718.             * Process it as a literal.
  719.             DO pars_lit
  720.          ENDIF
  721.          dl_lastrow = dl_atrow
  722.       ENDDO
  723.    ENDIF
  724.    SKIP
  725. ENDDO
  726. *
  727. DO line_inc
  728. * Write part two of the requested optional code.
  729. DO CASE
  730.    CASE dl_isentry
  731.       DO gen_entr WITH 2
  732.    CASE dl_ismenu
  733.       DO gen_menu WITH 2
  734.    CASE dl_isreprt
  735.       DO gen_rprt WITH 2
  736. ENDCASE
  737. *
  738. * Write file-closing command if one was opened.
  739. IF dl_isfile
  740.    DO line_inc
  741.    ?? [USE]
  742. ENDIF
  743. *
  744. DO line_inc
  745. DO line_inc
  746. ?? [WAIT ""]
  747. *
  748. * Close the target file.
  749. DO line_inc
  750. DO alt_file WITH dl_tfile, 2
  751. *
  752. * Restore environment.
  753. ON ESCAPE SUSPEND
  754. SET COLOR TO &dg_normal
  755. CLOSE INDEXES
  756. SET SAFETY OFF
  757. ERASE Dg_temp$.ndx
  758. ZAP
  759. SET SAFETY ON
  760. *
  761. * Restore parameter line, and close file.
  762. IF [] < dl_oldt
  763.    APPEND BLANK
  764.    REPLACE Dg_text WITH dl_oldt
  765. ENDIF
  766. USE
  767. *
  768. * Restore system parameters.
  769. IF dl_isdiffp
  770.    DO config WITH dl_oldp
  771. ENDIF
  772. *
  773. * Automatic DO of generated file.
  774. DO doer WITH dl_tfile
  775. *
  776. RETURN
  777. * EOP generate *******************************************************
  778.  
  779.  
  780. PROCEDURE gen_entr
  781. * Called from generate
  782. PARAMETERS dl_part
  783. *
  784. IF dl_part = 1
  785.    * Part one.
  786.    *
  787.    DO line_inc
  788.    ?? [* Entry algorithm]
  789.    DO line_inc
  790.    DO line_inc
  791.    ?? [CLEAR]
  792.    DO line_inc
  793.    *
  794. ELSE
  795.    * Part two.
  796.    DO line_inc
  797.    ?? [DO WHILE .T.]
  798.    *
  799.    DO line_inc
  800.    ?? [   @ 22,19 SAY "Press any key to edit, <S> to Save changes,"]
  801.    DO line_inc
  802.    ?? [   @ 23,18 SAY "or ] + dg_key + [ to return to menu without saving..."]
  803.    DO line_inc
  804.    ?? [   WAIT "" TO choice]
  805.    DO line_inc
  806.    ?? [   @ 22,19]
  807.    DO line_inc
  808.    ?? [   @ 23,18]
  809.    *
  810.    DO line_inc
  811.    ?? [   DO CASE]
  812.    DO line_inc
  813.    ?? [      CASE "" = choice]
  814.    DO line_inc
  815.    ?? [         RETURN]
  816.    DO line_inc
  817.    ?? [      CASE "S" = UPPER(choice)]
  818.    DO line_inc
  819.    ?? [         * Add replace statements here.]
  820.    DO line_inc
  821.    ?? [         RETURN]
  822.    DO line_inc
  823.    ?? [      OTHERWISE]
  824.    DO line_inc
  825.    ?? [         READ SAVE]
  826.    DO line_inc
  827.    ?? [   ENDCASE]
  828.    *
  829.    DO line_inc
  830.    ?? [ENDDO (WHILE .T.)]
  831.    DO line_inc
  832. ENDIF
  833. *
  834. RETURN
  835. *
  836. * EOP gen_entr *******************************************************
  837.  
  838.  
  839. PROCEDURE gen_menu
  840. * Called from generate
  841. PARAMETERS dl_part
  842. *
  843. IF dl_part = 1
  844.    * Part one.
  845.    *
  846.    *
  847.    DO line_inc
  848.    ?? [* Menu algorithm]
  849.    DO line_inc
  850.    DO line_inc
  851.    ?? [DO WHILE .T.]
  852.    DO line_inc
  853.    DO line_inc
  854.    ?? [   CLEAR]
  855.    DO line_inc
  856.    *
  857. ELSE
  858.    * Part two.
  859.    DO line_inc
  860.    ?? [   i = 0]
  861.    DO line_inc
  862.    ?? [   DO WHILE i = 0]
  863.    DO line_inc
  864.    ?? [      i = INKEY()]
  865.    DO line_inc
  866.    ?? [   ENDDO]
  867.    DO line_inc
  868.    ?? [   *]
  869.    DO line_inc
  870.    ?? [   DO CASE]
  871.    *
  872.    * Write the specified CASE statements.
  873.    SET ORDER TO 0
  874.    GO dl_menupos
  875.    SKIP
  876.    DO WHILE .NOT. ( EOF() .OR. [] = TRIM(Dg_text) )
  877.       DO line_inc
  878.       ?? [      CASE CHR(i) $ "] + LTRIM(RTRIM(Dg_text)) +["]
  879.       DO line_inc
  880.       ?? [         WAIT "Not implemented yet.  ]+;
  881.          [Press any key to return to menu..."]
  882.       SKIP
  883.    ENDDO
  884.    DO line_inc
  885.    ?? [      CASE i = 13]
  886.    DO line_inc
  887.    ?? [         RETURN]
  888.    DO line_inc
  889.    ?? [   ENDCASE]
  890.    DO line_inc
  891.    DO line_inc
  892.    ?? [ENDDO (WHILE .T.)]
  893. ENDIF
  894. *
  895. RETURN
  896. *
  897. * EOP gen_menu ********************************************************
  898.  
  899.  
  900. PROCEDURE gen_rprt
  901. * Called from generate
  902. PARAMETERS dl_part
  903. *
  904. IF dl_part = 1
  905.    * Part one.
  906.    *
  907.    DO line_inc
  908.    ?? [* Report algorithm]
  909.    DO line_inc
  910.    DO line_inc
  911.    ?? [* Prompt user to set up the printer or abort.]
  912.    DO line_inc
  913.    DO line_inc
  914.    ?? [@ 12,23 SAY "Printing.  Please do not disturb..."]
  915.    DO line_inc
  916.    DO line_inc
  917.    ?? [SET DEVICE TO PRINT]
  918.    DO line_inc
  919.    DO line_inc
  920.    ?? [DO WHILE (.NOT. EOF()) .AND. "" < DBF()     &] +;
  921.       [& report has to use a file]
  922.    DO line_inc
  923.    *
  924. ELSE
  925.    * Part two.
  926.    DO line_inc
  927.    ?? [   SKIP]
  928.    DO line_inc
  929.    ?? [ENDDO]
  930.    DO line_inc
  931.    DO line_inc
  932.    ?? [EJECT      &] +;
  933.       [& flush the last line from printer buffer]
  934.    DO line_inc
  935.    ?? [SET DEVICE TO SCREEN]
  936.    DO line_inc
  937.    ?? [@ 12,23 SAY "  *** ***  Done Printing  *** ***  "]
  938. ENDIF
  939. *
  940. RETURN
  941. *
  942. * EOP gen_rprt *******************************************************
  943.  
  944.  
  945. PROCEDURE helper  
  946. * Called from everything that can be called from the menu, plus the menu.
  947. * Calls the individual help screen when not called from menu.
  948. *
  949. PARAMETERS dl_from
  950. * 'dl_from' is same as selection number in main menu.
  951. *
  952. SET COLOR TO &dg_accent
  953. DO CASE
  954.    CASE dl_from = 1
  955.       DO hlp_crea
  956.    CASE dl_from = 2
  957.       DO hlp_edit
  958.    CASE dl_from = 3
  959.       DO hlp_gene
  960.    CASE dl_from = 4
  961.       DO hlp_mgen
  962.    CASE dl_from = 5
  963.       DO hlp_doer
  964.    CASE dl_from = 6
  965.       DO hlp_setu
  966.    CASE dl_from = 7
  967.       @  3,24 SAY "ARE YOU A REGISTERED dGENERATE?"
  968.       @  5,14 SAY "For a registration fee of fifteen dollars, you get"
  969.       @  6,13 SAY "an unprotected disk containing 3 copies of dGENERATE:"
  970.       @  8,13 SAY "1.  The source code in two files, main and procedure"
  971.       @  9,13 SAY "2.  A single command file coded and linked with RunTime+"
  972.       @ 10,13 SAY "3.  A single executable file compiled with Clipper"
  973.       @ 12, 9 SAY "Also on the disk is a text file with additional " +;
  974.                   "documentation."
  975.       @ 14,14 SAY "REGISTRATION ENTITLES YOU TO FULL TECHNICAL SUPPORT,"
  976.       @ 15,12 SAY "and contributes to the development of software like this."
  977.       @ 17,29 SAY "Tom Rettig Associates"
  978.       @ 18,23 SAY "9300 Wilshire Boulevard, Suite 470"
  979.       @ 19,28 SAY "Beverly Hills, CA  90212"
  980.       @ 20,10 SAY "Phone:(213)272-3784 -- CompuServe:75066,352 "+;
  981.                   "-- Source:BCR480"
  982. ENDCASE
  983. *
  984. IF dl_from # 2
  985.    * Only single page help screens should take this branch.
  986.    * (Two page help screens use hlp_togl.)
  987.    @ 23,26 SAY "Press any key to continue..."
  988.    SET COLOR TO &dg_normal
  989.    dl_i = 0
  990.    DO key_time WITH COL()
  991. ENDIF
  992. *
  993. * Clear help screen and repaint bottom marquee line before returning.
  994. SET COLOR TO &dg_normal
  995. @  3,0 CLEAR
  996. @ 21,0 SAY dg_line
  997. RETURN
  998. *
  999. * EOP helper *********************************************************
  1000.  
  1001.  
  1002. PROCEDURE hlp_crea
  1003. * Help screen for crea_new (1), called from helper
  1004. *
  1005. @ 4,0
  1006. TEXT
  1007.     1.  A target "screen-form" file is created in which you draw your screen.
  1008.          - You will be prompted for its filename, and it has a default 
  1009. ENDTEXT
  1010. *
  1011. ? "           extension of ." + dg_fscr_in + ;
  1012.   " if you do not specify a different one."
  1013. *
  1014. TEXT
  1015.  
  1016.     2.  You will be asked if you want to add names from a database file.
  1017.          - If you answer yes, you will be prompted for a database filename.
  1018.          - Memory variable names are generated from this file's field names, 
  1019.            and both are placed in the screen-form for your use.
  1020.  
  1021.     3.  After the screen-form file is created, you are automatically placed
  1022.         in editing mode where you draw your screen with your favorite word
  1023.         processor.  Specify your own word processor by choosing number 
  1024.         six <S>etup on the main menu.
  1025. ENDTEXT
  1026. *
  1027. RETURN
  1028. * EOP hlp_crea *******************************************************
  1029.  
  1030.  
  1031. PROCEDURE hlp_doer
  1032. * Help screen for doer (5), called from helper
  1033. *
  1034. @ 6,0
  1035. TEXT
  1036.        1.  This module simply runs any executable dBASE III program. 
  1037.  
  1038.  
  1039.        2.  It is called automatically upon completion of generating
  1040.            a new executable command file from a screen-form file.
  1041.  
  1042.  
  1043.        3.  If the DO file crashes, press 'S' to SUSPEND, type 
  1044.            RETURN and RESUME, and you will be back in dGENERATE 
  1045.            ready to <E>dit your file.
  1046. ENDTEXT
  1047. *
  1048. RETURN
  1049. * EOP hlp_doer *******************************************************
  1050.  
  1051.  
  1052. PROCEDURE hlp_edit
  1053. * Help screen for edit (2), called from helper
  1054. *
  1055. * This initialization makes first screen come up.
  1056. dl_i      = 49
  1057. dl_screen = 2
  1058. *
  1059. DO WHILE .T.
  1060.    DO CASE
  1061.       CASE dl_screen = 2 .AND. CHR(dl_i) $ "1pP"
  1062.          *
  1063.          @ 4,0
  1064.          TEXT
  1065.    - The first (top) line is a ruler for your convenience in placing things.
  1066.  
  1067.    - Then there is the area where you draw your screen-form:
  1068.  
  1069.          ENDTEXT
  1070.          ? "           " + LEFT(dg_ruler,29) + "     " +;
  1071.                                             "<----[ruler line]"
  1072.          ?
  1073.          ? "           First name: " + dg_atsay + "1                    <--+"
  1074.          ? "            Last name: " + dg_atget +;
  1075.                                      "n____________:          |-[screen area]"
  1076.          ? "              Address: " + dg_atget + "Street_Address___:   <--+"
  1077.          TEXT
  1078.           ^          ^ ^^^               ^
  1079.           ^-Literals-^ ||^---Optional----^
  1080.                        ||
  1081.        GET/SAY Symbol--'`--Definition Symbol (expression defined below)
  1082.          ENDTEXT
  1083.          dl_screen = 1
  1084.       *
  1085.       *
  1086.       CASE dl_screen = 1 .AND. CHR(dl_i) $ "2nN"
  1087.          @ 3,0
  1088.          TEXT
  1089.    - Under the screen-form is the definition table marked by 'dgDEFINE'.
  1090.      This is where you define the symbols used in the screen-form by
  1091.      assigning them to an expression and, optionally, a variable name.
  1092.  
  1093.    - Anywhere below the screen-form, you can specify a code algorithm
  1094.      to be generated such as menu, entry, report, or open file.
  1095.  
  1096.           dgDEFINE                                <--+
  1097.           1 First_name PICTURE "AAAAAAAA"            |-[definition table]
  1098.          ENDTEXT
  1099.          ? "          n m_lname   " + dg_init +;
  1100.                                      [ Last_name FUNCTION "!"       |]
  1101.          ? "          S m_address " + dg_init +;
  1102.                                      [ SPACE(25)                 <--+]
  1103.          TEXT
  1104.                       |
  1105.                       `-------------------[memvar initialization symbol]
  1106.  
  1107.           dgFILE Names                            <--|-[options]              
  1108.           dgENTRY                                 <--+                         
  1109.          ENDTEXT
  1110.          dl_screen = 2
  1111.       OTHERWISE
  1112.          RETURN
  1113.    ENDCASE
  1114.    *
  1115.    dl_i = 0
  1116.    DO hlp_togl
  1117. ENDDO
  1118. *
  1119. * EOP hlp_edit *******************************************************
  1120.  
  1121.  
  1122. PROCEDURE hlp_gene
  1123. * Help screen for generate (3), called from helper
  1124. *
  1125. @ 5,0
  1126. TEXT
  1127.        1.  When prompted, just enter the name of a screen-form file 
  1128.            that you created and edited; dGENERATE will do the rest.
  1129.  
  1130.      
  1131.        2.  You can change from relative addressing (@ ROW()+1,0) to 
  1132.            "hard coded" numeric coordinates (@ 5,0) in number six
  1133.            <S>etup on the main menu.
  1134.  
  1135.     
  1136.        3.  After the executable dBASE code is generated, the file will 
  1137.            be run automatically so that you can see the results.
  1138. ENDTEXT
  1139. *
  1140. RETURN
  1141. * EOP hlp_gene *******************************************************
  1142.  
  1143.  
  1144. PROCEDURE hlp_mgen
  1145. * Help screen for mem_gen (4), called from helper
  1146. *
  1147. @ 2,79 SAY []
  1148. TEXT
  1149.    1.  Memory variable names are generated from the file's field names.
  1150.        Only eight characters of the field name are significant in this
  1151.        operation: 'First_name' becomes 'm_first_na'.
  1152.    
  1153.    2.  Three sets of commands are generated using the memory variable 
  1154.        names and field names from the database file.
  1155.         - The first set is composed of memory variable initialization 
  1156.           statements from the file (memvar = Field).
  1157.         - The second set is composed of memory variable initialization 
  1158.           statements from an expression (memvar = CTOD("  /  /  ")).
  1159.         - The third set is composed of REPLACE statements to transfer
  1160.           data from the memory variables to the file's fields 
  1161.           (REPLACE Field WITH memvar).
  1162.    
  1163.    3.  This code is not intended to run as it stands.  It is to be 
  1164.        incorporated in your program by reading it into your command file 
  1165.        or procedure using your word processor.  Your program will probably 
  1166.        use only some of this code, and the rest can be discarded.
  1167. ENDTEXT
  1168. *
  1169. RETURN
  1170. * EOP hlp_mgen *******************************************************
  1171.  
  1172.  
  1173. PROCEDURE hlp_setu
  1174. * Help screen for setup (6), called from helper
  1175. *
  1176. @ 5,0
  1177. TEXT
  1178.           1.  These are the system parameters that dGENERATE uses.
  1179.  
  1180.  
  1181.           2.  Information about each parameter is displayed
  1182.               when the parameter is selected.
  1183.  
  1184.  
  1185.           3.  You can change them for temporary use and still retain
  1186.               the original system defaults, or you can make your 
  1187.               changes the new default.
  1188. ENDTEXT
  1189. *
  1190. RETURN
  1191. * EOP hlp_setu *******************************************************
  1192.  
  1193.  
  1194. PROCEDURE hlp_togl
  1195. * Called from hlp_edit
  1196. * For two-screen helps
  1197. *
  1198. SET COLOR TO &dg_normal
  1199. @ 22,28 SAY "This is screen number " + IIF(dl_screen=1,"one","two")
  1200. SET COLOR TO &dg_accent
  1201. @ 23,13 SAY IIF(dl_screen=1,"  2 - <N>ext screen  ","1 - <P>revious screen")-;
  1202.             ", or any other key to continue..."
  1203. *
  1204. * 'dl_i' and 'dl_screen' are initialized in the calling program.
  1205. SET COLOR TO &dg_normal
  1206. DO key_time WITH IIF(dl_screen=2,COL(),COL()-2)
  1207. *
  1208. @  3,0 CLEAR
  1209. @ 21,0 SAY dg_line
  1210. SET COLOR TO &dg_accent
  1211. RETURN
  1212. * EOP hlp_togl *******************************************************
  1213.  
  1214.  
  1215. PROCEDURE key_time
  1216. * Called from main, fileprmt, helper, hlp_togl, setup
  1217. * Also see marquee.
  1218. PARAMETERS dl_column
  1219. *
  1220. dl_j = 0
  1221. * 'dl_i' must be initialized to zero in calling program.
  1222. DO WHILE dl_i = 0
  1223.    @  1,53 SAY IIF(VAL(TIME())<12,            TIME()    + " am",;
  1224.                IIF(VAL(TIME())=12,            TIME()    + " pm",;
  1225.                STR(VAL(TIME())-12,2) + SUBSTR(TIME(),3) + " pm"))
  1226.    @ 23,dl_column SAY []    && positions cursor to end of prompt
  1227.    *
  1228.    * Wait for a keypress or the time to change.
  1229.    dl_t = TIME()
  1230.    DO WHILE dl_t = TIME() .AND. dl_i = 0   
  1231.       dl_i = INKEY()
  1232.    ENDDO
  1233.    *
  1234.    * Time out after <n> seconds.
  1235.    dl_j = dl_j+1
  1236.    IF dl_j = 180
  1237.       RETURN
  1238.    ENDIF
  1239. ENDDO
  1240. *
  1241. RETURN
  1242. * EOP key_time *******************************************************
  1243.  
  1244.  
  1245. PROCEDURE line_inc
  1246. * Called from generate, gen_entr, gen_menu, gen_rprt, mem_gen, write
  1247. * Call before writing output statements when they are displayed on screen.
  1248. * Furnishes the carriage return before each line and tests for new screen.
  1249. *
  1250. ?
  1251. IF ROW() # 21
  1252.    RETURN
  1253. ENDIF
  1254. *
  1255. @  3,0
  1256. @  4,0
  1257. @  5,0
  1258. @  6,0
  1259. @  7,0
  1260. @  8,0
  1261. @  9,0
  1262. @ 10,0
  1263. @ 11,0
  1264. @ 12,0
  1265. @ 13,0
  1266. @ 14,0
  1267. @ 15,0
  1268. @ 16,0
  1269. @ 17,0
  1270. @ 18,0
  1271. @ 19,0
  1272. @ 20,0
  1273. @  3,0 SAY []
  1274. *
  1275. RETURN
  1276. * EOP line_inc *******************************************************
  1277.  
  1278.  
  1279. PROCEDURE marquee
  1280. * Called from crea_new, doer, editor, generate, helper, mem_gen, 
  1281. * and setup.  Expects color to be dg_dim.  Also see key_time.
  1282. *
  1283. PARAMETERS dl_title
  1284. * LEN(dl_title) must be 23
  1285. *
  1286. CLEAR
  1287. @  1, 0 SAY [d G E N E R A T E   -  -] + dl_title +;
  1288.             [-  -               -  -]
  1289. @  1,53 SAY IIF(VAL(TIME())<12,            TIME()    + " am",;
  1290.             IIF(VAL(TIME())=12,            TIME()    + " pm",;
  1291.             STR(VAL(TIME())-12,2) + SUBSTR(TIME(),3) + " pm"))
  1292. @  1,72 SAY DATE()
  1293. @  2, 0 SAY dg_line
  1294. @ 21, 0 SAY dg_line
  1295. RETURN
  1296. * EOP marquee *********************************************************
  1297.  
  1298.  
  1299. PROCEDURE mem_gen
  1300. * Called from menu
  1301. *
  1302. CLEAR
  1303. DO marquee WITH [   Generating Memvars  ]
  1304. *
  1305. IF dg_ishelp
  1306.    DO helper WITH 4
  1307. ENDIF
  1308. *
  1309. * Prompt for name of source database file.
  1310. * (target file name is constructed from this)
  1311. dl_sourcef = [ ]
  1312. dl_defext  = [dbf]
  1313. STORE .F. TO dl_istargt, dl_isedit
  1314. DO fileprmt
  1315. IF dg_iserror
  1316.    RETURN
  1317. ENDIF
  1318. *
  1319. * Target filename is automatic from source file.
  1320. STORE SUBSTR(dl_sourcef,1,AT(".",dl_sourcef)) + dg_fmemout ;
  1321.       TO dl_tgfile, dl_abortf
  1322. *
  1323. dl_oldt = []   && for abort if dg.dbf is specified
  1324. DO wait_msg WITH 1
  1325. DO file_msg WITH dl_sourcef, dl_tgfile
  1326. *
  1327. * Copy to a structure-extended file to get the field specs.
  1328. USE &dl_sourcef
  1329. SET SAFETY OFF
  1330. COPY TO Dg_temp$ STRUCTURE EXTENDED
  1331. USE Dg_temp$
  1332. *
  1333. * Convert field names to lowercase.
  1334. REPLACE ALL Field_name WITH LOWER(Field_name)
  1335. *
  1336. * Index the structure file.
  1337. INDEX ON Field_type + Field_name TO Dg_temp$
  1338. SET SAFETY ON
  1339. *
  1340. DO wait_msg WITH 2
  1341. *
  1342. * Open target file, and write its header.
  1343. DO alt_file WITH dl_tgfile, 1
  1344. *
  1345. * Output the initialization statements from expressions.
  1346. DO line_inc
  1347. ?? [* Initialization commands from expressions.]
  1348. dl_zeros = "00000000000000000000"
  1349. DO WHILE .NOT. EOF()
  1350.    DO line_inc
  1351.    DO CASE
  1352.       CASE Field_type = "C"
  1353.          ?? [m_] + SUBSTR(Field_name,1,8) + [ = SPACE(] +;
  1354.                    STR(Field_len,3) + [)]
  1355.       CASE Field_type = "D"
  1356.          ?? [m_] + SUBSTR(Field_name,1,8) + [ = CTOD("  /  /  ")]
  1357.       CASE Field_type = "L"
  1358.          ?? [m_] + SUBSTR(Field_name,1,8) + [ = .F.]
  1359.       CASE Field_type = "N" .AND. Field_dec = 0
  1360.          ?? [m_] + SUBSTR(Field_name,1,8) + [ = ] +;
  1361.                    SUBSTR(dl_zeros,1,Field_len-Field_dec)
  1362.       CASE Field_type = "N" .AND. Field_dec > 0
  1363.          ?? [m_] + SUBSTR(Field_name,1,8) + [ = ] +;
  1364.                    SUBSTR(dl_zeros,1,Field_len-Field_dec-1) + [.] +;
  1365.                    SUBSTR(dl_zeros,1,Field_dec)
  1366.    ENDCASE
  1367.    *
  1368.    SKIP
  1369. ENDDO
  1370. *
  1371. * Output the initialization statements from file fields.
  1372. DO line_inc
  1373. DO line_inc
  1374. ?? [* Initialization commands from fields.]
  1375. GO TOP
  1376. DO WHILE .NOT. EOF()
  1377.    DO line_inc
  1378.    ?? [m_] + SUBSTR(Field_name,1,8) + [ = ] + ;
  1379.       UPPER(SUBSTR(Field_name,1,1)) + SUBSTR(Field_name,2,9)
  1380.    SKIP
  1381. ENDDO
  1382. *
  1383. * Output the REPLACE statements.
  1384. DO line_inc
  1385. DO line_inc
  1386. ?? [* Replace commands.]
  1387. GO TOP
  1388. DO WHILE .NOT. EOF()
  1389.    DO line_inc
  1390.    ?? [REPLACE ] + UPPER(SUBSTR(Field_name,1,1)) + SUBSTR(Field_name,2,9) +;
  1391.       [ WITH m_] + SUBSTR(Field_name,1,8)
  1392.    SKIP
  1393. ENDDO
  1394. *
  1395. * Close the target file.
  1396. DO line_inc
  1397. DO line_inc
  1398. DO alt_file WITH dl_tgfile, 2
  1399. *
  1400. * Restore the environment, and return to menu.
  1401. ON ESCAPE SUSPEND
  1402. USE
  1403. ERASE Dg_temp$.dbf
  1404. ERASE Dg_temp$.ndx
  1405. SET COLOR TO &dg_normal
  1406. RETURN
  1407. * EOP mem_gen ********************************************************
  1408.  
  1409.  
  1410. PROCEDURE pars_lit
  1411. * Called from generate
  1412. *
  1413. * It's a literal prompt; save the pointer (dl_i) and 
  1414. * reposition it to the next dg_atget, dg_atsay, or eol.
  1415. dl_start   = dl_i
  1416. dl_nextsay = AT(dg_atsay,dl_str)
  1417. dl_nextget = AT(dg_atget,dl_str)
  1418. DO CASE
  1419.    CASE dl_nextsay + dl_nextget = 0
  1420.       * Point past end-of-line.
  1421.       dl_i = dg_eol+1
  1422.    CASE dl_nextsay = 0
  1423.       * Point to next dg_atget symbol.
  1424.       dl_i = dl_i-1 + dl_nextget
  1425.    CASE dl_nextget = 0
  1426.       * Point to next dg_atsay symbol.
  1427.       dl_i = dl_i-1 + dl_nextsay
  1428.    OTHERWISE
  1429.       * Point to next dg_atsay or dg_atget symbol, whichever is first.
  1430.       dl_i = dl_i-1 + IIF(dl_nextsay < dl_nextget, dl_nextsay, dl_nextget)
  1431. ENDCASE
  1432. *
  1433. * Write the literal prompt, trimming any trailing blanks.
  1434. DO write WITH TRIM( SUBSTR(dl_line,dl_start,dl_i-dl_start) ),;
  1435.               dl_start, .T., .T.
  1436. *
  1437. RETURN
  1438. * EOP pars_lit *******************************************************
  1439.  
  1440.  
  1441. PROCEDURE pars_var
  1442. * Called from generate
  1443. *
  1444. * Activate index file for searching the variable definitions table.
  1445. SET ORDER TO 1
  1446. *
  1447. * See if the next character is listed in the definitions table.
  1448. SEEK SUBSTR(dl_str, 2, 1) + [ ]
  1449. DO CASE
  1450.    CASE FOUND() .AND. dg_init $ Dg_text
  1451.       * If it is an initialized memvar, the expression has been tested.
  1452.       * Write the @...SAY or @...GET variable name and the 
  1453.       * picture or function clause if any.
  1454.       dl_phrase = LTRIM(RTRIM(SUBSTR(Dg_text,3)))
  1455.       dl_loc    = IIF(" PICT"$UPPER(dl_phrase),AT(" PICT",UPPER(dl_phrase)),;
  1456.                                                AT(" FUNC",UPPER(dl_phrase)))
  1457.       DO write WITH TRIM(LEFT(dl_phrase,AT(dg_init,dl_phrase)-1))+;
  1458.        IIF(dl_loc>0,IIF("PICT"$UPPER(dl_phrase)," PICTURE "," FUNCTION ")+;
  1459.        LTRIM(SUBSTR(dl_phrase,dl_loc+AT([ ],SUBSTR(dl_phrase,dl_loc+1)))),;
  1460.        []), dl_i, dl_str=dg_atsay, .F.
  1461.    CASE FOUND() .AND. .NOT. dg_init $ Dg_text
  1462.       * If defined, but not initialized, it's an expression.
  1463.       * Test the expression and write it or the 'undefined' variable.
  1464.       * Expression test is duplicated in generate.
  1465.       dl_phrase = LTRIM(RTRIM(SUBSTR(Dg_text,3)))
  1466.       dl_loc    = IIF(" PICT"$UPPER(dl_phrase),AT(" PICT",UPPER(dl_phrase)),;
  1467.                                          AT(" FUNC",UPPER(dl_phrase)))
  1468.       *
  1469.       * Uninitialized variable name will get through as valid
  1470.       * character expression.  Necessary to let field names through.
  1471.       DO write WITH ;
  1472.            IIF(TYPE("IIF(dl_loc>0,LEFT(dl_phrase,dl_loc),dl_phrase)")="U",;
  1473.                [undefined],dl_phrase), dl_i, dl_str=dg_atsay, .F.
  1474.    OTHERWISE
  1475.       * Not defined at all, write the memvar 'undefined'.
  1476.       DO write WITH [undefined], dl_i, dl_str=dg_atsay, .F.
  1477. ENDCASE
  1478. *
  1479. * Point to next character if there is one, or past eol.
  1480. dl_i = IIF(AT(LTRIM(SUBSTR(dl_line,dl_i-1+AT(" ",dl_str)) ),;
  1481.         dl_str) > 0 .AND. AT(" ",dl_str) > 0, ;
  1482.         dl_i-1 + AT( LTRIM( SUBSTR(dl_line,dl_i-1+AT(" ",dl_str)) ), dl_str),;
  1483.         dg_eol+1)
  1484. *
  1485. SET ORDER TO 0
  1486. RETURN
  1487. * EOP pars_var *******************************************************
  1488.  
  1489.  
  1490. PROCEDURE setup
  1491. * Called from menu
  1492. DO marquee WITH [  Setting Up dGENERATE ]
  1493. *
  1494. IF dg_ishelp
  1495.    DO helper WITH 6
  1496. ENDIF
  1497. *
  1498. * SAYs.
  1499. dg_p1  = "Characters used to denote GETs:  and SAYs:"
  1500. dg_p2  = "Character used for the initialization code:"
  1501. dg_p3  = "Size of screen-form in ROWs:    and COLumns:"
  1502. dg_p4  = "Relative Addressing?:"
  1503. dg_p5  = "Ruler line in screen-form?:"
  1504. dg_p6  = "Delimiters on?:"
  1505. dg_p7  = "Fill screen-form with blanks?:"
  1506. dg_p8  = "Help screens on?:"
  1507. dg_p9  = "Default file extensions for drawing screens:   , code generated:"
  1508. dg_p10 = "memvar names generated:"
  1509. dg_p11 = "Characters used to make up ruler in COLumn zero: , every ten:"
  1510. dg_p12 = "Characters used for left and right delimiters:"
  1511. dg_p13 = "Character used for marquee lines in this program (ASCII value):"
  1512. dg_p14 = "Filename of word processor used for editing screen-forms:"
  1513. *
  1514. * GETs.
  1515. dl_atget   = dg_atget
  1516. dl_atsay   = dg_atsay
  1517. dl_init    = dg_init
  1518. dl_eol     = dg_eol
  1519. dl_eos     = dg_eos
  1520. dl_isreltv = dg_isreltv
  1521. dl_isruler = dg_isruler
  1522. dl_isdelim = dg_isdelim
  1523. dl_isfill  = dg_isfill
  1524. dl_ishelp  = dg_ishelp
  1525. dl_fmemout = dg_fmemout
  1526. dl_fscrout = dg_fscrout
  1527. dl_fscr_in = dg_fscr_in
  1528. dl_rule1   = dg_rule1
  1529. dl_rule    = dg_rule
  1530. dl_delim   = dg_delim
  1531. dl_char    = dg_char
  1532. dl_wp      = dg_wp
  1533. *
  1534. SET COLOR TO &dg_accent
  1535. @  3, 1 SAY "<A> -->"
  1536. @  4, 1 SAY "<B> -->"
  1537. @  5, 1 SAY "<C> -->"
  1538. @  7, 1 SAY "<D> -->"
  1539. @  8, 1 SAY "<E> -->"
  1540. @  9, 1 SAY "<F> -->"
  1541. @ 10, 1 SAY "<G> -->"
  1542. @ 11, 1 SAY "<H> -->"
  1543. @ 13, 1 SAY "<I> -->"
  1544. @ 16, 1 SAY "<J> -->"
  1545. @ 18, 1 SAY "<K> -->"
  1546. @ 19, 1 SAY "<L> -->"
  1547. @ 20, 1 SAY "<M> -->"
  1548. *
  1549. SET COLOR TO &dg_normal
  1550. @  3, 9 SAY dg_p1
  1551. @  4, 9 SAY dg_p2
  1552. @  5, 9 SAY dg_p3
  1553. @  7, 9 SAY dg_p4
  1554. @  8, 9 SAY dg_p5
  1555. @  9, 9 SAY dg_p6
  1556. @ 10, 9 SAY dg_p7
  1557. @ 11, 9 SAY dg_p8
  1558. @ 13, 9 SAY dg_p9
  1559. @ 14,50 SAY dg_p10
  1560. @ 16, 9 SAY dg_p11
  1561. @ 18, 9 SAY dg_p12
  1562. @ 19, 9 SAY dg_p13
  1563. @ 20, 9 SAY dg_p14
  1564. *
  1565. * If delimiters are being used in screens, don't use them here.
  1566. IF dg_isdelim
  1567.    SET DELIMITERS OFF
  1568. ENDIF
  1569. *
  1570. @  3,40 GET dl_atget 
  1571. @  3,51 GET dl_atsay 
  1572. @  4,52 GET dl_init 
  1573. @  5,37 GET dl_eos PICTURE "###" 
  1574. @  5,53 GET dl_eol PICTURE "###"
  1575. @  7,30 GET dl_isreltv 
  1576. @  8,36 GET dl_isruler 
  1577. @  9,24 GET dl_isdelim
  1578. @ 10,39 GET dl_isfill
  1579. @ 11,26 GET dl_ishelp 
  1580. @ 13,53 GET dl_fscr_in 
  1581. @ 13,73 GET dl_fscrout 
  1582. @ 14,73 GET dl_fmemout 
  1583. @ 16,57 GET dl_rule1 
  1584. @ 16,70 GET dl_rule 
  1585. @ 18,55 GET dl_delim 
  1586. @ 19,72 GET dl_char PICTURE "###"
  1587. @ 20,66 GET dl_wp 
  1588. *
  1589. CLEAR GETS
  1590. SET BELL ON
  1591. *
  1592. DO WHILE .T.
  1593.    SET COLOR TO &dg_accent
  1594.    @ 22,8 SAY "Choose item to change by letter, "+;
  1595.               "<T> to use these <T>emporarily,"
  1596.    @ 23,8 SAY "<S> to <S>ave as system defaults, or " + dg_key +;
  1597.               " to abort any changes."
  1598.    SET COLOR TO &dg_normal
  1599.    *
  1600.    dl_i = 0
  1601.    DO key_time WITH COL()
  1602.    @ 22,8
  1603.    @ 23,8
  1604.    *
  1605.    SET COLOR TO &dg_accent
  1606.    dl_istrap = .T.
  1607.    *
  1608.    * Split up to speed up an otherwise very long DO CASE structure.
  1609.    DO CASE
  1610.       CASE LOWER(CHR(dl_i)) >= 'a' .AND. LOWER(CHR(dl_i)) <= 'd'
  1611.          DO set_if1
  1612.       CASE LOWER(CHR(dl_i)) >= 'e' .AND. LOWER(CHR(dl_i)) <= 'i'
  1613.          Do set_if2
  1614.       CASE LOWER(CHR(dl_i)) >= 'j' .AND. LOWER(CHR(dl_i)) <= 'm'
  1615.          Do set_if3
  1616.       CASE CHR(dl_i) $ "tsTS" .OR. dl_i = 13 .OR. dl_i = 0
  1617.          EXIT
  1618.    ENDCASE
  1619.    @ 22,0
  1620.    @ 23,0
  1621. ENDDO [WHILE .T.]
  1622. *
  1623. * Exit routine.
  1624. IF dl_i # 13 .AND. dl_i # 0
  1625.    @ 23,27 SAY "Saving these parameters..."
  1626.    *
  1627.    * Write a new dg_param line.
  1628.    dl    = [ ]
  1629.    dl_re = IIF(dl_isreltv, "T", "F")
  1630.    dl_ru = IIF(dl_isruler, "T", "F")
  1631.    dl_d  = IIF(dl_isdelim, "T", "F")
  1632.    dl_f  = IIF(dl_isfill , "T", "F")
  1633.    dl_h  = IIF(dl_ishelp , "T", "F")
  1634. DO config WITH [parameters: ]+dl_atget+dl+dl_atsay+dl+dl_init+dl+;
  1635.  STR(dl_eol,3)+dl+STR(dl_eos,3)+dl+dl_re+dl+dl_ru+dl+dl_d+dl+dl_f+dl+dl_h+dl+;
  1636.  dl_fmemout+dl+dl_fscrout+dl+dl_fscr_in+dl+dl_rule1+dl+dl_rule+dl+;
  1637.  dl_delim+dl+STR(dl_char,3)+dl+dl_wp
  1638.    *
  1639.    * Branch to make these the system defaults.
  1640.    IF CHR(dl_i) $ "sS"
  1641.       USE dg
  1642.       IF RECCOUNT() = 0
  1643.          APPEND BLANK
  1644.       ENDIF
  1645.       REPLACE Dg_text WITH dg_param
  1646.       USE
  1647.    ENDIF (save to file)
  1648. ENDIF (save temporarily)
  1649. *
  1650. * If delimiters are being used in screens, turn them back on.
  1651. IF dg_isdelim
  1652.    SET DELIMITERS ON
  1653. ENDIF
  1654. *
  1655. SET COLOR TO &dg_normal
  1656. SET BELL OFF
  1657. RETURN
  1658. *
  1659. * EOP setup **********************************************************
  1660.  
  1661.  
  1662. PROCEDURE set_if1
  1663. * Called from setup
  1664. *
  1665. DO CASE
  1666.    CASE CHR(dl_i) $ [aA]
  1667.       @  3, 9 SAY dg_p1
  1668.       @ 22,18 SAY "GET and SAY must each use different symbols."
  1669.       @ 23, 6 SAY "Neither symbol may be used in a "+;
  1670.                   "literal prompt in the screen-form..."
  1671.       DO WHILE dl_istrap
  1672.          @  3,40 GET dl_atget
  1673.          @  3,51 GET dl_atsay
  1674.          READ
  1675.          dl_istrap = dl_atget = [ ] .OR. dl_atsay = [ ] .OR.;
  1676.                      dl_atget = dl_atsay 
  1677.       ENDDO
  1678.       SET COLOR TO &dg_normal
  1679.       @  3, 9 SAY dg_p1
  1680.       @  3,40 GET dl_atget
  1681.       CLEAR GETS
  1682.    CASE CHR(dl_i) $ [bB]
  1683.       @  4, 9 SAY dg_p2
  1684.       @ 23, 8 SAY "Initialization symbol cannot be any of " +;
  1685.                   "these: []<>()`'^*/+-|:.&= "
  1686.       DO WHILE dl_istrap
  1687.          @  4,52 GET dl_init 
  1688.          READ
  1689.          dl_istrap = dl_init $ "[]<>()`'^*/+-|:.&= "
  1690.       ENDDO
  1691.       SET COLOR TO &dg_normal
  1692.       @  4, 9 SAY dg_p2
  1693.    CASE CHR(dl_i) $ [cC]
  1694.       @  5, 9 SAY dg_p3
  1695.       @  5,37 GET dl_eos PICTURE "###" RANGE 1,999
  1696.       @  5,53 GET dl_eol PICTURE "###" RANGE 1,254
  1697.       @ 23,18 SAY "Range for ROWs: 1..999, and COLumns: 1..254."
  1698.       READ
  1699.       SET COLOR TO &dg_normal
  1700.       @  5, 9 SAY dg_p3
  1701.       @  5,37 GET dl_eos PICTURE "###" RANGE 1,999
  1702.       CLEAR GETS
  1703.    CASE CHR(dl_i) $ [dD]
  1704.       @  7, 9 SAY dg_p4
  1705.       @  7,30 GET dl_isreltv
  1706.       @ 23,26 SAY "Can be True/Yes or False/No."
  1707.       READ
  1708.       SET COLOR TO &dg_normal
  1709.       @  7, 9 SAY dg_p4
  1710. ENDCASE
  1711. *
  1712. RETURN
  1713. * EOP set_if1 ********************************************************
  1714.  
  1715.  
  1716. PROCEDURE set_if2
  1717. * Called from setup
  1718. *
  1719. DO CASE
  1720.    CASE CHR(dl_i) $ [eE]
  1721.       @  8, 9 SAY dg_p5
  1722.       @  8,36 GET dl_isruler 
  1723.       @ 23,26 SAY "Can be True/Yes or False/No."
  1724.       READ
  1725.       SET COLOR TO &dg_normal
  1726.       @  8, 9 SAY dg_p5
  1727.    CASE CHR(dl_i) $ [fF]
  1728.       @  9, 9 SAY dg_p6
  1729.       @  9,24 GET dl_isdelim 
  1730.       @ 23,26 SAY "Can be True/Yes or False/No."
  1731.       READ
  1732.       SET COLOR TO &dg_normal
  1733.       @  9, 9 SAY dg_p6
  1734.    CASE CHR(dl_i) $ [gG]
  1735.       @ 10, 9 SAY dg_p7
  1736.       @ 10,39 GET dl_isfill 
  1737.       @ 23,26 SAY "Can be True/Yes or False/No."
  1738.       READ
  1739.       SET COLOR TO &dg_normal
  1740.       @ 10, 9 SAY dg_p7
  1741.    CASE CHR(dl_i) $ [hH]
  1742.       @ 11, 9 SAY dg_p8
  1743.       @ 11,26 GET dl_ishelp 
  1744.       @ 23,26 SAY "Can be True/Yes or False/No."
  1745.       READ
  1746.       SET COLOR TO &dg_normal
  1747.       @ 11, 9 SAY dg_p8
  1748.    CASE CHR(dl_i) $ [iI]
  1749.       @ 13, 9 SAY dg_p9
  1750.       @ 14,50 SAY dg_p10
  1751.       @ 22,17 SAY "Each file type must use a different extension."
  1752.       @ 23,17 SAY "Extensions cannot begin with a blank or a dot."
  1753.       DO WHILE dl_istrap
  1754.          @ 13,53 GET dl_fscr_in
  1755.          @ 13,73 GET dl_fscrout
  1756.          @ 14,73 GET dl_fmemout
  1757.          READ
  1758.          dl_istrap = dl_fscr_in=dl_fscrout .OR. dl_fscr_in=dl_fmemout .OR.;
  1759.                      dl_fscrout=dl_fmemout .OR. LEFT(dl_fscr_in,1)$[. ] .OR.;
  1760.                      LEFT(dl_fscrout,1)$[. ] .OR. LEFT(dl_fmemout,1)$[. ]
  1761.       ENDDO
  1762.       SET COLOR TO &dg_normal
  1763.       @ 13, 9 SAY dg_p9
  1764.       @ 13,53 GET dl_fscr_in
  1765.       @ 14,50 SAY dg_p10
  1766.       CLEAR GETS
  1767. ENDCASE
  1768. *
  1769. RETURN
  1770. * EOP set_if2 ********************************************************
  1771.  
  1772.  
  1773. PROCEDURE set_if3
  1774. * Called from setup
  1775. *
  1776. DO CASE
  1777.    CASE CHR(dl_i) $ [jJ]
  1778.       @ 16, 9 SAY dg_p11
  1779.       @ 16,57 GET dl_rule1
  1780.       @ 16,70 GET dl_rule
  1781.       @ 23, 9 SAY "Ruler line is same length as screen-form " +;
  1782.                   "COLumns in <C> above."
  1783.       READ
  1784.       SET COLOR TO &dg_normal
  1785.       @ 16, 9 SAY dg_p11
  1786.       @ 16,57 GET dl_rule1
  1787.       CLEAR GETS
  1788.    CASE CHR(dl_i) $ [kK]
  1789.       @ 18, 9 SAY dg_p12
  1790.       @ 23,25 SAY "Left delimiter cannot be blank."
  1791.       DO WHILE dl_istrap
  1792.          @ 18,55 GET dl_delim
  1793.          READ
  1794.          dl_istrap = dl_delim = [ ]
  1795.       ENDDO
  1796.       SET COLOR TO &dg_normal
  1797.       @ 18, 9 SAY dg_p12
  1798.    CASE CHR(dl_i) $ [lL]
  1799.       @ 19, 9 SAY dg_p13
  1800.       @ 19,72 GET dl_char PICTURE "###" RANGE 1,255
  1801.       @ 23,29 SAY "ASCII range is 1..255."
  1802.       READ
  1803.       SET COLOR TO &dg_normal
  1804.       @  2, 0 SAY REPLICATE(CHR(dl_char),80)   && display new marquee lines
  1805.       @ 19, 9 SAY dg_p13
  1806.       @ 21, 0 SAY REPLICATE(CHR(dl_char),80)
  1807.    CASE CHR(dl_i) $ [mM]
  1808.       @ 20, 9 SAY dg_p14
  1809.       @ 22,12 SAY "Filename can be up to eight characters " +;
  1810.                   "with no extension."
  1811.       @ 23, 7 SAY "Set operating system path if located in " +;
  1812.                   "another drive or directory."
  1813.       DO WHILE dl_istrap
  1814.          @ 20,66 GET dl_wp PICTURE [AXXXXXXX]
  1815.          READ
  1816.          dl_istrap = dl_wp = [ ] .OR. [.] $ dl_wp
  1817.       ENDDO
  1818.       SET COLOR TO &dg_normal
  1819.       @ 20, 9 SAY dg_p14
  1820. ENDCASE
  1821. *
  1822. RETURN
  1823. * EOP set_if3 ********************************************************
  1824.  
  1825.  
  1826. PROCEDURE wait_msg
  1827. * Called from crea_new, generate, mem_gen
  1828. PARAMETERS dl_part
  1829. *
  1830. IF dl_part = 1
  1831.    @ 11,21 SAY "This takes a moment, please be patient."
  1832.    @ 22,25 SAY "Press the Escape key to abort."
  1833.    ON ESCAPE DO abort WITH dl_abortf
  1834.    * dl_abortf is initialized and ON ESCAPE is restored 
  1835.    * in the calling program.
  1836. ELSE
  1837.    @ 11,21
  1838. ENDIF
  1839. *
  1840. RETURN
  1841. * EOP wait_msg *****************************************************
  1842.  
  1843.  
  1844. PROCEDURE write
  1845. * Called from pars_lit, pars_var
  1846. *
  1847. PARAMETERS dl_str, dl_column, dl_issay, dl_isquote
  1848. * Passed string has been TRIMmed and is not null [].
  1849. *
  1850. * Write the @...<coordinates> part of the command.
  1851. DO line_inc
  1852. IF dg_isreltv
  1853.    ?? [@ ] + IIF(dl_isreprt, "PROW()", "ROW()") + IIF(dl_atrow = dl_lastrow,;
  1854.       IIF(dl_atrow-dl_lastrow<10, [   ], [    ]),;
  1855.       "+" +STR(dl_atrow-dl_lastrow,2)) + [,] + STR(dl_column-1,dg_max)
  1856. ELSE
  1857.    ?? [@ ] + STR(dl_atrow,dg_max) + [,] + STR(dl_column-1,dg_max)
  1858. ENDIF
  1859. *
  1860. * Write the expression part of the command.
  1861. IF dl_issay .AND. dl_isquote
  1862.    * It's a literal prompt.
  1863.    IF LEN(dl_str) <= 60
  1864.       ?? [ SAY "] + dl_str + ["]
  1865.    ELSE
  1866.       * Break long string every 40 columns.
  1867.       ?? [ SAY "] + SUBSTR(dl_str, 1,40) + [" +;]
  1868.       dl_str = SUBSTR(dl_str,41)
  1869.       DO WHILE LEN(dl_str) > 40
  1870.          DO line_inc
  1871.          ?? IIF(dg_isreltv, [                  "], [            "]) +;
  1872.             SUBSTR(dl_str, 1,40) + [" +;]
  1873.          dl_str = SUBSTR(dl_str,41)
  1874.       ENDDO
  1875.       *
  1876.       DO line_inc
  1877.       ?? IIF(dg_isreltv, [                  "], [            "]) +;
  1878.          dl_str + ["]
  1879.    ENDIF
  1880. ELSE
  1881.    * It's a variable name.
  1882.    ?? IIF(dl_issay .OR. dl_isreprt, [ SAY ], [ GET ]) + dl_str
  1883. ENDIF
  1884. *
  1885. RETURN
  1886. * EOP write **********************************************************
  1887.  
  1888. * EOF: dg_proc.prg \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  1889.