home *** CD-ROM | disk | FTP | other *** search
/ Share Gallery 1 / share_gal_1.zip / share_gal_1 / LA / LA015.ZIP / DG_MAIN.PRG < prev    next >
Text File  |  1985-09-02  |  7KB  |  194 lines
  1. * Program..: dGENERATE
  2. * Filename.: dg_main.prg
  3. * Author...: Tom Rettig
  4. * Dates....: 3/28/84, 8/30/84, 12/29/84, 12/30/84, 12/31/84,
  5. *            1/03/85, 1/04/85,  1/05/85,  1/06/85,  1/11/85,
  6. *            1/13/85, 1/15/85,  1/25/85,  1/26/85,  1/27/85,
  7. *            1/29/85, 1/30/85,  2/01/85,  2/09/85,  2/10/85,
  8. *            2/13/85, 2/16/85,  2/17/85,  2/18/85,  2/19/85,
  9. *            2/23/85, 2/24/85,  2/25/85,  3/17/85,  4/01/85,
  10. *            6/26/85, 6/27/85,  7/01/85,  7/29/85
  11. * Revisions: 9/02/85: Added WAIT in test for versions 1.0 and 1.1.
  12. *
  13. * Notice...: Copyright 1985 by Tom Rettig Associates.
  14. *            All Rights Reserved.
  15. * Version..: 1.0 (x30)
  16. * Run under: dBASE III, any version greater than 1.1, or dBRUN.
  17. * Notes....: Entry into dGENERATE and main menu.
  18. *
  19. * Files required: dg_proc.prg (unless broken up for linking)
  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. * Memory variable naming conventions: 
  26. *                          dg_* is a global system variable
  27. *                          dl_* is a local routine variable
  28. *
  29. * Test for invalid versions of dBASE.
  30. IF TYPE('3') = "C"
  31.    ? "dGENERATE does not run under dBASE II."
  32.    QUIT
  33. ENDIF
  34. IF SQRT(100) # 10
  35.    ? "dGENERATE requires a version of dBASE III later than 1.1."
  36.    WAIT
  37.    QUIT
  38. ENDIF
  39. *
  40. * Display copyright notice while setting up.
  41. CLEAR
  42. @  1,32 SAY "d G E N E R A T E"
  43. @  3,27 SAY "Version 1.0  (August, 1985)"
  44. @ 12,19 SAY "This message appears only during the time"
  45. @ 13,19 SAY "that it takes for dGENERATE to get loaded."
  46. @ 21,11 SAY "Copyright 1985, Tom Rettig Associates, All Rights Reserved"
  47. @ 22,10 SAY "9300 Wilshire Boulevard, Suite 470, Beverly Hills, CA  90212"
  48. @ 23,10 SAY "Phone:(213)272-3784 -- Source:BCR480 -- CompuServe:75066,352"
  49. *
  50. SET TALK OFF
  51. *
  52. * Check system file, and exit if missing or invalid structure.
  53. ON ERROR dg_iserror = .T.
  54. USE dg
  55. dg_iserror = "DG_TEXT" # FIELD(1) .OR. LEN(Dg_text) < 254 .OR. [] # FIELD(2)
  56. ON ERROR
  57. IF dg_iserror
  58.    CLEAR
  59.    @  3,37 SAY "Oops!"
  60.    @  5, 9 SAY "There is no database file called 'dg.dbf' "+;
  61.                "where I can find it,"
  62.    @  6,20 SAY "or the structure of dg.dbf is incorrect."
  63.    @  8, 8 SAY "dGENERATE requires a dBASE III database file "+;
  64.                "with the structure:"
  65.    @ 10,24 SAY "Structure for database:  dg.dbf"
  66.    @ 11,24 SAY "Field  Field Name  Type       Width"
  67.    @ 12,28 SAY "1  DG_TEXT     Character    254"
  68.    @ 13,24 SAY "** Total **                     255"
  69.    @ 15,17 SAY "dg.dbf can be located in a drive or directory"
  70.    @ 16,15 SAY "that is not the current default, only if you have"
  71.    @ 17,16 SAY "SET PATH TO its location from within dBASE III."
  72.    @ 20,21 SAY "Press any key to return to dBASE III..."
  73.    *
  74.    * Restore environment, and exit this program.
  75.    USE
  76.    SET TALK ON
  77.    WAIT []  && placed here so time taken by USE is while reading
  78.    RETURN
  79. ENDIF
  80. *
  81. * Set up working environment and system defaults.
  82. ON ESCAPE SUSPEND
  83. SET PROCEDURE TO dg_proc
  84. *
  85. * Initialize global system variables.  Used in place of PUBLIC
  86. * which has to be released explicitly by name.
  87. STORE .F. TO dg_atget,dg_atsay,dg_blankfl,dg_char,dg_delim,dg_eol,dg_eos,;
  88.   dg_fmemout,dg_fscrout,dg_fscr_in,dg_isdelim,dg_isfill,dg_ishelp,dg_isreltv,;
  89.   dg_isruler,dg_init,dg_line,dg_max,dg_param,dg_rule,dg_rule1,dg_ruler,dg_wp
  90. *
  91. * Add new system variables here and in 'config' and 'setup'.
  92. *
  93. dg_ptest = 67    && length of a valid trimmed parameter line
  94. *
  95. * Take parameters from file if they are there, or use defaults.
  96. * IIF() parameter test is different from the one in 'generate'.
  97. DO config WITH IIF(RECCOUNT()>0 .AND. Dg_text=[parameters: ] .AND.;
  98. LEN(TRIM(Dg_text))>=dg_ptest .AND. SUBSTR(Dg_text,27,1)$[TF] .AND.;
  99. SUBSTR(Dg_text,35,1)$[TF],Dg_text,;
  100. "parameters: { } ~  80  24 F T F F T dgm dgp dgs 0 123456789. ::  61         ")
  101. *         1  ^ ^ ^ ^2  ^   ^ ^3^ ^ ^    4         5         6    ^   ^7
  102. *123456789.123456789.123456789.123456789.123456789.123456789.123456789.123456
  103. *            | | | |   |   | | | | |                             |   | 
  104. *        get-' | | |   |   | | | | `-help      menu char (ascii)-'   |
  105. *          say-' | |   |   | | | `-blank fill         word processor-'
  106. *      init code-' |   |   | | `-delimiters  
  107. *     screen width-'   |   | |
  108. *        screen length-'   | |
  109. *      relative addressing-' |
  110. *                 ruler line-'
  111. *                             |
  112. *   <- In screen-form file <- | -> Not in screen-form file ->
  113. *            (1..29)          |              (30..76)
  114. *
  115. * Set up the screen handling and hardware specific memvars. 
  116. dg_key = IIF("UNIX"$OS(),"RETURN","ENTER")  && Enter/Return key
  117. IF ISCOLOR()
  118.    * Screen codes, color.
  119.    dg_accent = [GR+/R,W/GR,GR]
  120.    dg_normal = [GR/R ,W/GR,GR]
  121. ELSE
  122.    * Screen codes, mono.
  123.    dg_accent = [W+]
  124.    dg_normal = [W]
  125. ENDIF
  126. *
  127. USE
  128. SET BELL OFF
  129. SET COLOR TO                && establish default values
  130. SET COLOR TO &dg_normal     && reset the first parameter
  131. *
  132. * In source code version only.
  133. DO marquee WITH [     Registration      ]
  134. DO helper WITH 7
  135. *
  136. * Main menu is at the highest level so that RETURN TO MASTER
  137. * can get to it from the 'abort' procedure.
  138. DO WHILE .T.
  139.    CLEAR
  140.    DO marquee WITH [   M A I N   M E N U   ]
  141.    *
  142.    SET COLOR TO &dg_accent
  143.    @  7, 5 SAY "1 - <C>reate a new screen-form         " +;
  144.                "5 - <D>o a program file"
  145.    @ 10, 5 SAY "2 - <E>dit existing screen-form        " +;
  146.                "6 - <S>etup new parameters"
  147.    @ 13, 5 SAY "3 - <G>enerate screen-form code        " +;
  148.                "7 - <R>egistration information"
  149.    @ 16, 5 SAY "4 - <M>ake memvars from fields         " +;
  150.                "0 - <Q>uit to dBASE III"
  151.    @ 23,21 SAY "Select an action by number or letter..."
  152.    SET COLOR TO &dg_normal
  153.    *
  154.    dl_i = 0
  155.    DO key_time WITH COL()
  156.    @ 23,21
  157.    *
  158.    DO CASE
  159.       CASE CHR(dl_i) $ "Cc1"
  160.          DO crea_new
  161.       CASE CHR(dl_i) $ "Ee2"
  162.          DO editor WITH []
  163.       CASE CHR(dl_i) $ "Gg3"
  164.          DO generate WITH []
  165.       CASE CHR(dl_i) $ "Mm4"
  166.          DO mem_gen
  167.       CASE CHR(dl_i) $ "Dd5"
  168.          DO doer WITH []
  169.       CASE CHR(dl_i) $ "Ss6"
  170.          DO setup
  171.       CASE CHR(dl_i) $ "Rr7"
  172.          DO marquee WITH [     Registration      ]
  173.          DO helper WITH 7
  174.       CASE CHR(dl_i) $ "Qq08"
  175.          EXIT
  176.       CASE dl_i = 0             && time out
  177.          @  7, 0 CLEAR
  178.          @ 21,23 SAY "Press any key to reactivate menu..."
  179.          WAIT []
  180.    ENDCASE
  181.    *
  182. ENDDO
  183. *
  184. * Restore environment, and exit from dGENERATE.
  185. ON ESCAPE
  186. CLOSE PROCEDURE
  187. SET BELL ON
  188. SET TALK ON
  189. SET COLOR TO
  190. CLEAR
  191. RETURN
  192. *
  193. * EOF: dg_main.prg
  194.