PROGRAM CMDGEN (INPUT, OUTPUT);
(* Written by Scott Sutcliffe on 10/05/85 *)
(* Gardena, CA - (213) 329-9020           *)

TYPE
    PICTYPE = STRING[25];
    REGISTERS = RECORD    (* MS-DOS REGISTER DEFINITION - OPTIONAL *)
    CASE INTEGER OF
         1: (AX, BX, CX, DX, BP, SI, DI, DS, ES, FLAGS : INTEGER);
         2: (AL,AH,BL,BH,CL,CH,DL,DH : BYTE);
    END;
CONST
     N = 'NAME';                     (* AUTO-PICTURE - NAME       *)
     SSN ='SSN';                     (* AUTO-PICTURE - SO SEC NO  *)
     D1 = 'BIRTH';                   (* AUTO-PICTURE - BIRTH DATE *)
     D2 = 'HIRE';                    (* AUTO-PICTURE - HIRE DATE  *)
     D3 = 'TERM';                    (* AUTO-PICTURE - TERM DATE  *)
     D4 = 'ENTRY';                   (* AUTO-PICTURE - ENTRY DATE *)
     DPIC = 'PICTURE "99/99/99"';    (* DATE PICTURE DEFINITION   *)
     SPIC = 'PICTURE "999-99-9999"'; (* SSN PICTURE DEFINITION    *)
                                     (* ARRAY OF DAYS AND MONTHS  *)
                                     (*     -- USES MS-DOS --     *)
                                     (*     --   OPTIONAL  --     *)
     SDAY : ARRAY [1..7] OF STRING[9] =
            ('Monday','Tuesday','Wedensday','Thursday','Friday',
                                             'Saturday','Sunday');
     SMONTH : ARRAY [1..12] OF STRING[9] =
            ('January','February','March','April','May','June','July','August'
                                  ,'September','October','November','December');
VAR
   R        : REGISTERS;             (* -- MSDOS REGISTERS -- *)
   F1       : TEXT;                  (* --  FILE VARIABLE  -- *)
   YN       : CHAR;                  (* -- Y/N ANSWER VAR  -- *)
   FLD      : STRING[15];            (* -- COMPARE VARIABLE-- *)
   DAY      : INTEGER;               (* --  MSDOS DAY VAR  -- *)
   PICS     : ARRAY [1..32] OF PICTYPE;(* -- ARRAY FOR DBASE PICTURES -- *)
   YEAR     : INTEGER;               (* --  MSDOS YEAR VAR -- *)
   FNAME    : STRING [14];           (* --  FILE NAME VAR  -- *)
   MONTH    : INTEGER;               (* -- MSDOS MONTH VAR -- *)
   INDEX    : INTEGER;               (* -- GENERAL PURPOSE -- *)
   DINDEX   : INTEGER;               (* -- MSDOS DAY INDEX -- *)
   UFNAME   : STRING [14];           (* --  USE FILE NAME  -- *)
   INDEX2   : INTEGER;               (* -- GENERAL PURPOSE -- *)
   FIELDS   : ARRAY [1..32] OF STRING[15]; (* ARRAY FOR DBASE FIELDS *)
   SHOWLAST : BOOLEAN;         (* -- SWITCH TO TELL IF NAME FIELD -- *)
                               (* -- EXISTS. IF SO, PREVIOUS RECD -- *)
                               (* -- NUMBER AND NAME ARE PRINTED. -- *)

PROCEDURE GETDATE;   (* -- REQUIRES MSDOS -- *)
BEGIN                (* -- DELETE IF CP/M -- *)
     WITH R DO BEGIN
     DS := SEG(R);   (* --  SET UP DSEG   -- *)
     AH := $2A;      (* --RETURN DATE FUNC-- *)
     MSDOS (R);      (* --    EXECUTE     -- *)
     DAY := DL;      (* -- DAY IN DL REG. -- *)
     MONTH := DH;    (* --  MONTH IN DH   -- *)
     YEAR := CX;     (* --  YEAR IN DX    -- *)
     DINDEX := AL;   (* --DAY NUMBER IN AL-- *)
     END;
     SMONTH [1] := 'January'; (* INIT MONTHS *)
     SMONTH [2] := 'February';
     SMONTH [3] := 'March';
     SMONTH [4] := 'April';
     SMONTH [5] := 'May';
     SMONTH [6] := 'June';
     SMONTH [7] := 'July';
     SMONTH [8] := 'August';
     SMONTH [9] := 'September';
     SMONTH [10] := 'October';
     SMONTH [11] := 'November';
     SMONTH [12] := 'December';
END;
(*$I GETCRSR.INC - NOTE THAT THIS PROCEDURE IS MS-DOS ONLY!!! IF USING CP/M *)
(*                 REPLACE THIS WITH A PROCEDURE THAT RETURNS THE CURSOR
                   ADDRESS IN THE FORMAT OF 'PROCEDURE GETCRSR (VAR V,H);'
                   WHERE V IS THE VERTICAL, AND H IS THE HORIZONTAL POSITION *)

PROCEDURE GETFILE;  (* ENTER FILE PROGRAM NAME AND DBASE 'USE' FILENAME *)
VAR
   F_SWITCH : BOOLEAN; (* VALID FILE SWITCH *)
   X : INTEGER;        (* CURSOR VERTICAL   *)
   Y : INTEGER;        (* CURSOR HORIZONTAL *)
BEGIN
     F_SWITCH := FALSE;          (* RESET FILE SWITCH *)
     WRITELN ('                                 CMDGEN 1.0');
     WRITELN ('                     dBASE II (tm) Command File Generator');
     WRITELN;
     WHILE NOT F_SWITCH DO BEGIN (* DO WHILE NOT A VALID FILE. *)
           WRITE('Enter Command File name:');
           READLN (FNAME);
           FNAME := FNAME+'.PRG';(* .PRG FILETYPE FOR 16 BIT VER, CHANGE TO .CMD FOR CP/M-80 *)
           ASSIGN (F1,FNAME);
     (*$I-*)
           REWRITE (F1);         (* ATTEMPT TO OPEN FILE *)
     (*$I+*)
           F_SWITCH := (IORESULT=0);  (* IF BAD FILENAME, F_SWITCH=FALSE, SO DO LOOP AGAIN *)
           IF NOT F_SWITCH THEN BEGIN (*-- MSDOS ONLY, IF USING GETCRSR!!! --*)
              GETCRSR(X,Y);
              GOTOXY (Y,X-1);
           END;
     END;
     WRITE('Enter USE filename:');
           READLN (UFNAME);
END;
PROCEDURE GETFIELDS;
                    (* MODULE TO ENTER IN FIELDS, AND CHECK TO SEE IF
                       THEY WARRENT AN AUTO-PICTURE (NAME, SSN, TERM
                       HIRE, ENTRY, BIRTH )                          *)
VAR
   SW : BOOLEAN;
   CURSORPOS : INTEGER;
BEGIN
     CURSORPOS := 3; (* STARTING CURSOR LINE *)
     INDEX2 := 2;    (* CURSOR ADDRESS -1 = FIELD NUMBER *)
     SW := FALSE;    (* SW FIELD = FALSE *)
     WHILE NOT SW DO BEGIN            (* DO WHILE THERE ARE MORE FIELDS TO ENTER *)
           GOTOXY (1,CURSORPOS+1);    (* SET UP CURSOR *)
           WRITE ('Enter name of field #',INDEX2-1,':');
           FIELDS[INDEX2-1] := '';    (* SPACE OUT CURRENT FIELD *)
           READLN (FIELDS[INDEX2-1]); (* INPUT CURRENT FIELD NAME *)
           IF FIELDS[INDEX2-1] = '' THEN SW := TRUE; (* FIELD = '', SO STOP *)
           IF NOT SW THEN BEGIN       (* FIELD WAS ENTERED, SO IDENTIFY *)
              FLD := FIELDS[INDEX2-1];(* STORE IN COMPARE VARIABLE *)
              IF (FLD=D1) OR (FLD=D2) OR (FLD=D3) OR (FLD=D4) (* DATE AUTO-PIC? *)
               THEN BEGIN                                     (* YES! *)
                    PICS[INDEX2-1] := DPIC; (* STORE DATE PICTURE TO MEMORY *)
                    GOTOXY (40,CURSORPOS+1);(* SET UP CURSOR *)
                    WRITELN(PICS[INDEX2-1]);(* DISPLAY PIC TO RIGHT OF NAME *)
               END
               ELSE
                   IF FLD=SSN THEN BEGIN
                      PICS[INDEX2-1] := SPIC;  (* STORE SSN PIC TO MEMORY *)
                      GOTOXY (40,CURSORPOS+1); (* SET UP CURSOR *)
                      WRITELN (PICS[INDEX2-1]);(* DISPLAY PIC TO RIGHT OF NAME *)
                   END
                   ELSE
                       IF FLD=N                               (* NAME, SO NO PIC *)
                       THEN PICS[INDEX2-1] := ' '
                       ELSE IF FIELDS [INDEX2-1] <> '' THEN BEGIN
                            WRITE ('PICTURE Y/N?');   (* NO AUTO-PIC - USER PIC THOUGH? *)
                            READLN (YN);              (* YES/NO VARIABLE *)
                            YN := UPCASE(YN);         (* UPPERCASE YN    *)
                            GOTOXY (1,CURSORPOS+2);   (* GO DOWN ONE LINE *)
                            IF YN='Y' THEN BEGIN      (* USER WANTS A PICTURE *)
                               WRITE('ENTER PICTURE:');
                               READLN(PICS[INDEX2-1]);(* ENTER IT AS WISHED, WITHOUT QUOTES *)
                               GOTOXY (1,CURSORPOS+2);(* CLEAR PICTURE INPUT LINE *)
                               WRITE ('                                              ');
                               PICS[INDEX2-1] := 'PICTURE "'+PICS[INDEX2-1]+'"'; (*USER PIC*)
                               GOTOXY (40,CURSORPOS+1);(* SET UP CURSOR *)
                               WRITELN(PICS[INDEX2-1]);(* DISPLAY USER PICTURE TO RIGHT OF NAME *)
                            END
                            ELSE PICS[INDEX2-1] := ' '; (* NO PICTURE *)
                       END;
           INDEX2 := INDEX2 + 1;             (* INCREMENT FIELD INDEX *)
           CURSORPOS := CURSORPOS+1;         (* INCREMENT CURSOR INDEX*)
         END;
     END;
END;

PROCEDURE INITFILE;              (* ACTUAL CODING FOR ANY FILE *)
BEGIN
     WRITELN (F1,'* '+FNAME);
     WRITELN (F1,'* Generated with CMDGEN.PAS');
     GETDATE;   (* -- MS DOS -- *)
     WRITELN (F1,'* on ',SDAY [DINDEX],', ',SMONTH[MONTH],' ',DAY,', ',YEAR); (*-- MS DOS --*)
     WRITELN (F1,'SET TALK OFF');
     WRITELN (F1,'USE ',UFNAME);
     WRITELN (F1,'STORE " " TO DONE');
     WRITELN (F1,'ERASE');
     WRITELN (F1,'STORE 0 TO ERA');
     WRITELN (F1,'APPEND BLANK');
     WRITELN (F1,'DO WHILE DONE # "X"');
     WRITELN (F1,'   STORE ERA+1 TO ERA');
     WRITELN (F1,'   IF ERA =7');
     WRITELN (F1,'      ERASE');
     WRITELN (F1,'      STORE 0 TO ERA');
     WRITELN (F1,'   ENDIF');
     WRITELN (F1,'   STORE " " TO DONE');
END;

PROCEDURE WRITEFILE;  (* ACTUAL CODING FOR REST OF FILE, BASED ON USER INPUT *)
BEGIN
     IF SHOWLAST THEN BEGIN       (* NAME FIELD FOUND - PRINT LAST REC *)
        WRITELN (F1,'   SKIP -1');
        WRITELN (F1,'   @ 1,1 SAY "LAST NAME = "+NAME');
        WRITELN (F1,'   SKIP');
     END;
     FOR INDEX := 1 TO INDEX2-2 DO BEGIN  (* @ SAY'S  *)
         IF SHOWLAST THEN       (* NAME FIELD FOUND, SO INCREMENT INDEX BY 1 *)
            WRITELN(F1,'   @ ',INDEX+1,',1 SAY "',FIELDS[INDEX],'" GET ',FIELDS[INDEX],' ',PICS[INDEX])
         ELSE
            WRITELN(F1,'   @ ',INDEX,',1 SAY "',FIELDS[INDEX],'" GET ',FIELDS[INDEX],' ',PICS[INDEX]);
     END;
     WRITELN (F1,'   READ');
     WRITE   (F1,'   @ ',INDEX2,',1 SAY "HIT E TO EDIT, P FOR PREVIOUS, F FOR FORWARD OR  X TO STOP"');
     WRITELN (F1,' GET DONE PICTURE "!"');
     WRITELN (F1,'   READ');
     WRITELN (F1,'   @ ',INDEX2,',1 SAY "                                                                    "');
     WRITELN (F1,'   DO CASE');
     WRITELN (F1,'      CASE DONE="E"');
     WRITELN (F1,'           LOOP');
     WRITELN (F1,'      CASE DONE="F"');
     WRITELN (F1,'           SKIP');
     WRITELN (F1,'      CASE DONE="P"');
     WRITELN (F1,'           SKIP -1');
     WRITELN (F1,'      CASE DONE#"X"');
     WRITELN (F1,'           APPEND BLANK');
     WRITELN (F1,'   ENDCASE');
     WRITELN (F1,'ENDDO');
     WRITELN (F1,'SET TALK ON');
END;

BEGIN
     CLRSCR;
     GETFILE;
     CLRSCR;
     WRITELN ('                                 CMDGEN 1.0');
     WRITE ('Filename = '+FNAME,'  -  Database Filename = ',UFNAME+'.DBF');
     GETFIELDS;
     SHOWLAST := FALSE;
     FOR INDEX := 1 TO INDEX2-1 DO
         IF FIELDS[INDEX] = N THEN SHOWLAST := TRUE;
     INITFILE;
     WRITEFILE;
     CLOSE (F1);
END.