Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : DGENIII.ZIP
Filename : DGMAIN.PRG

* Program..: dGENERATE
* Filename.: dg_main.prg
* Author...: Tom Rettig
* Dates....: 3/28/84, 8/30/84, 12/29/84, 12/30/84, 12/31/84,
* 1/03/85, 1/04/85, 1/05/85, 1/06/85, 1/11/85,
* 1/13/85, 1/15/85, 1/25/85, 1/26/85, 1/27/85,
* 1/29/85, 1/30/85, 2/01/85, 2/09/85, 2/10/85,
* 2/13/85, 2/16/85, 2/17/85, 2/18/85, 2/19/85,
* 2/23/85, 2/24/85, 2/25/85, 3/17/85, 4/01/85,
* 6/26/85, 6/27/85, 7/01/85, 7/29/85
* Notice...: Copyright 1985 by Tom Rettig Associates.
* All Rights Reserved.
* Version..: 1.0 (x30)
* Run under: dBASE III, any version greater than 1.1, or dBRUN.
* Notes....: Entry into dGENERATE and main menu.
*
* Files required: dg_proc.prg (unless broken up for linking)
* dg.dbf --> Structure for database: dg.dbf
* Field Field Name Type Width
* 1 DG_TEXT Character 254
* ** Total ** 255
*
* Memory variable naming conventions:
* dg_* is a global system variable
* dl_* is a local routine variable
*
* Test for invalid versions of dBASE.
IF TYPE('3') = "C"
? "dGENERATE does not run under dBASE II."
QUIT
ENDIF
IF SQRT(100) # 10
? "dGENERATE requires a version of dBASE III later than 1.1."
QUIT
ENDIF
*
* Display copyright notice while setting up.
CLEAR
@ 1,32 SAY "d G E N E R A T E"
@ 3,27 SAY "Version 1.0 (August, 1985)"
@ 12,19 SAY "This message appears only during the time"
@ 13,19 SAY "that it takes for dGENERATE to get loaded."
@ 21,11 SAY "Copyright 1985, Tom Rettig Associates, All Rights Reserved"
@ 22,10 SAY "9300 Wilshire Boulevard, Suite 470, Beverly Hills, CA 90212"
@ 23,10 SAY "Phone:(213)272-3784 -- Source:BCR480 -- CompuServe:75066,352"
*
SET TALK OFF
*
* Check system file, and exit if missing or invalid structure.
ON ERROR dg_iserror = .T.
USE dg
dg_iserror = "DG_TEXT" # FIELD(1) .OR. LEN(Dg_text) < 254 .OR. [] # FIELD(2)
ON ERROR
IF dg_iserror
CLEAR
@ 3,37 SAY "Oops!"
@ 5, 9 SAY "There is no database file called 'dg.dbf' "+;
"where I can find it,"
@ 6,20 SAY "or the structure of dg.dbf is incorrect."
@ 8, 8 SAY "dGENERATE requires a dBASE III database file "+;
"with the structure:"
@ 10,24 SAY "Structure for database: dg.dbf"
{ @ 11,24 SAY "Field Field Name Type Width"
@ 12,28 SAY "1 DG_TEXT Character 254"
@ 13,24 SAY "** Total ** 255"
@ 15,17 SAY "dg.dbf can be located in a drive or directory"
@ 16,15 SAY "that is not the current default, only if you have"
@ 17,16 SAY "SET PATH TO its location from within dBASE III."
@ 20,21 SAY "Press any key to return to dBASE III..."
*
* Restore environment, and exit this program.
USE
SET TALK ON
WAIT [] && placed here so Q7ime taken by USE is while reading
RETURN
ENDIF
*
* Set up working environment and system defaults.
ON ESCAPE SUSPEND
SET PROCEDURE TO dg_proc
*
* Initialize global system variables. Used in place of PUBLIC
* which has to be released explicitly by name.
STORE .F. TO dg_atget,dg_atsay,dg_blankfl,dg_char,dg_delim,dg_eol,dg_eos,;
dg_fmemout,dg_fscrout,dg_fscr_in,dg_isdelim,dg_isfill,dg_ishelp,dg_isreltv,;
dg_isruler,dg_init,dg_line,dg_max,dg_param,dg_rule,dg_rule1,dg_ruler,dg_wp
*
* Add new system variables here and in 'config' and 'setup'.
*
dg_ptest = 67 && length of a valid trimmed parameter line
*
* Take parameters from file if they are there, or use defaults.
* IIF() parameter test is different from the one in 'generate'.
DO config WITH IIF(RECCOUNT()>0 .AND. Dg_text=[parameters: ] .AND.;
LEN(TRIM(Dg_text))>=dg_ptest .AND. SUBSTR(Dg_text,27,1)$[TF] .AND.;
SUBSTR(Dg_text,35,1)$[TF],Dg_text,;
"parameters: { } ~ 80 24 F T F F T dgm dgp dgs 0 123456789. :: 61 ")
* 1 ^ ^ ^ ^2 ^ ^ ^3^ ^ ^ 4 5 6 ^ ^7
*123456789.123456789.123456789.123456789.123456789.123456789.123456789.123456
* | | | | | | | | | | | |
* get-' | | | | | | | | `-help menu char (ascii)-' |
* say-' | | | | | | `-blank fill word processor-'
* init code-' | | | | `-delimiters
* screen width-' | | |
* screen length-' | |
* relative addressing-' |
* ruler line-'
* |
* <- In screen-form file <- | -> Not in screen-form file ->
* (1..29) | (30..76)
*
* Set up the screen handling and hardware specific memvars.
dg_key = IIF("UNIX"$OS(),"RETURN","ENTER") && Enter/Return key
IF ISCOLOR()
* Screen codes, color.
dg_accent = [GR+/R,W/GR,GR]
dg_normal = [GR/R ,W/GR,GR]
ELSE
* Screen codes, mono.
dg_accent = [W+]
dg_normal = [W]
ENDIF
*
USE
SET BELL OFF
SET COLOR TO && establish default values
SET COLOR TO &dg_normal && reset the first parameter
*
* In source code version only.
DO marquee WITH [ Registration ]
DO helper WITH 7
*
* Main menu is at the highest level so that RETURN TO MASTER
* can get to it from the 'abort' procedure.
DO WHILE .T.
CLEAR
DO marquee WITH [ M A I N M E N U ]
*
SET COLOR TO &dg_accent
@ 7, 5 SAY "1 - reate a new screen-form " ++{
"5 - o a program file"
@ 10, 5 SAY "2 - dit existing screen-form " +;
"6 - etup new parameters"
@ 13, 5 SAY "3 - enerate screen-form code " +;
"7 - egistration information"
{ @ 16, 5 SAY "4 - ake memvars from fields " +;
"0 - uit to dBASE III"
@ 23,21 SAY "Select an action by number or letter..."
SET COLOR TO &dg_normal
*
dl_i = 0
DO key_time WITH COL()
@ 23,21
*
DO CASE
CASE CHR(dl_i) $ "Cc1"
DO crea_new
CASE CHR(dl_i) $ "Ee2"
DO editor WITH []
CASE CHR(dl_i) $ "Gg3"
DO generate WITH []
CASE CHR(dl_i) $ "Mm4"
DO mem_gen
CASE CHR(dl_i) $ "Dd5"
DO doer WITH []
CASE CHR(dl_i) $ "Ss6"
DO setup
CASE CHR(dl_i) $ "Rr7"
DO marquee WITH [ Registration ]
DO helper WITH 7
CASE CHR(dl_i) $ "Qq08"
EXIT
CASE dl_i = 0 && time out
@ 7, 0 CLEAR
@ 21,23 SAY "Press any key to reactivate menu..."
WAIT []
ENDCASE
*
ENDDO
{*
* Restore environment, and exit from dGENERATE.
ON ESCAPE
CLOSE PROCEDURE
SET BELL ON
SET TALK ON
SET COLOR TO
CLEAR
RETURN
*
* EOF: dg_main.prg