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