home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol024 / nad4.pas < prev    next >
Pascal/Delphi Source File  |  1984-04-29  |  9KB  |  339 lines
  1. PROGRAM NAD_ENTRY_V4;
  2. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  3. {+  PROGRAM TITLE:    Name and Address Entry            +}
  4. {+            version #4                 +}
  5. {+                                +}
  6. {+  WRITTEN BY:        Raymond E. Penley            +}
  7. {+  DATE WRITTEN:    Sept 25, 1980                +}
  8. {+                                +}
  9. {+  WRITTEN FOR:    A Name And Address (NAD) data entry    +}
  10. {+            program.  The output is written        +}
  11. {+            specifically in the format that the    +}
  12. {+            word processor Magic Wand uses.        +}
  13. {+                                +}
  14. {+  SUMMARY                            +}
  15. {+  I. EDITING ENTRIES.                        +}
  16. {+    The program has a very limited editing capability.    +}
  17. {+    Before typing the return key if an entry is not        +}
  18. {+    correct then just type the ESCAPE key. This will    +}
  19. {+    erase the entire line just entered. You then have to    +}
  20. {+    reinput that entry.  No other editing is available    +}
  21. {+    while in the program. Extensive editing must be        +}
  22. {+    done outside the data entry program such as with    +}
  23. {+    the word processor.                    +}
  24. {+                                +}
  25. {+ II. TERMINATION.                        +}
  26. {+    When at the FULL NAME data entry item simply entering    +}
  27. {+    a carriage return only will end the session, update    +}
  28. {+    and close the output file.                +}
  29. {+                                +}
  30. {+ III. RECORD FORMAT USED.                    +}
  31. {+    LINE #                            +}
  32. {+    1    RECORD #nn    < FILLED IN BY PROGRAM >    +}
  33. {+    2    FULL NAME                    +}
  34. {+    3    ADDRESS LINE 1    < USED FOR A ONE LINE ADDRESS >    +}
  35. {+    4    ADDRESS LINE 2    < LEAVE BLANK IF ONLY 1 LINE  >    +}
  36. {+    5    CITY                        +}
  37. {+    6    STATE        < USE POST OFFICE 2 CHAR CODES >+}
  38. {+    7    ZIP CODE                    +}
  39. {+    8    SALUTATION                    +}
  40. {+    9    CODES        < ANY TYPE OF CODES YOU REQUIRE>+}
  41. {+    10    BLANK LINE                    +}
  42. {+                                +}
  43. {+                                +}
  44. {+ IV. INPUT/OUTPUT FILES                    +}
  45. {+   INPUT is from a video terminal (must have cursor        +}
  46. {+    addressing)                        +}
  47. {+   OUTPUT FILE is an ASCII text file with file name        +}
  48. {+    per your specifications.                +}
  49. {+                                +}
  50. {+   MODIFICATION RECORD                    +}
  51. {+     SEPT 24, 80  -ADDED LIMITED EDITING CAPABILITY.        +}
  52. {+             ENTERING AN ESCAPE CHAR WILL ALLOW ONE TO  +}
  53. {+             REDO THAT LINE OVER AGAIN.            +}
  54. {+     NOV 22, 80   -ADDED TELEVIDEO TERMINAL FUNCTIONS.    +}
  55. {+                                +}
  56. {++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  57.  
  58. CONST
  59.   Default = 80;     { Default length of all strings }
  60.   FileIdLength = 14;
  61.   ESC_CODE = 27; {ASCII Escape code}
  62.   NewLine = 13;  {ASCII carriage return code}
  63.  
  64. TYPE
  65.   TermType    = (ADM, TVI, SOROC, H19, SOL);
  66.   BYTE        = 0..255;
  67.   dflt_string    = string default;
  68.   FID        = string FileIdLength;
  69.   max_string    = string 255;
  70.   sequence    = packed array [1..2] of char;
  71.   S$0        = string 0;
  72.   S$255        = string 255;
  73.  
  74. VAR
  75.   bell        : char;
  76.   clear        : char;
  77.   current_record: integer;
  78.   done        : boolean;
  79.   esc        : char;
  80.   filename    : FID;
  81.   home        : char;
  82.   Terminal    : TermType;
  83.  
  84.   f1_line,f2_line,
  85.   f3_line,f4_line,
  86.   f5_line,f6_line,
  87.   f7_line,f8_line,
  88.  
  89.   f1_col,f2_col,
  90.   f3_col,f4_col,
  91.   f5_col,f6_col,
  92.   f7_col,f8_col: BYTE;
  93.  
  94.   LineDelete,            { Delete line that cursor is on    }
  95.   LineErase,            { Erase from cursor to end of line }
  96.   HintOn,            { Half Intensity On           }
  97.   HintOff,            { Half Intensity Off           }
  98.   INVON,            { Inverse Video On           }
  99.   INVOFF    : sequence;    { Inverse Video Off           }
  100.  
  101.   ADDR1,
  102.   ADDR2,
  103.   CITY,
  104.   CODES,
  105.   FULLNAME,
  106.   SALUTE,
  107.   STATE,
  108.   ZIP        : DFLT_STRING;
  109.  
  110.   FOUT        : TEXT;
  111.  
  112. {$C- <<<<<<<<<<<<<<<<<<<CONTROL-C CHECKING OFF>>>>>>>>>>>>>>>>>>>>>>}
  113. {$F- <<<<<<<<<<<<<<FLOATING POINT MATH CHECKING OFF>>>>>>>>>>>>>>>>>}
  114. {$M- <<<<<<<<<<<<<<INTEGER MULT & DIVD CHECKING OFF>>>>>>>>>>>>>>>>>}
  115.  
  116. FUNCTION LENGTH(X:S$255):INTEGER;EXTERNAL;
  117.  
  118. PROCEDURE SETLENGTH(VAR X:S$0; Y:INTEGER);EXTERNAL;
  119.  
  120. PROCEDURE KEYIN(VAR C:CHAR);EXTERNAL;
  121.  
  122. PROCEDURE WRITEONE;
  123. BEGIN
  124.   WRITELN(FOUT,'RECORD #',CURRENT_RECORD:1);
  125.   WRITELN(FOUT,FULLNAME);
  126.   WRITELN(FOUT,ADDR1);
  127.   IF ( LENGTH(ADDR2)>0 ) THEN
  128.      WRITELN(FOUT,ADDR2)
  129.   ELSE
  130.      WRITELN(FOUT);
  131.   WRITELN(FOUT,CITY);
  132.   WRITELN(FOUT,STATE);
  133.   WRITELN(FOUT,ZIP);
  134.   WRITELN(FOUT,SALUTE);
  135.   WRITELN(FOUT,CODES);
  136.   WRITELN(FOUT);
  137. END;
  138.  
  139.  
  140. PROCEDURE PLOT(row, column: BYTE);
  141. { Sequence
  142.     ESC + "=" + CHR( LINE+31 ) + CHR( COLUMN+31 )
  143. }
  144. BEGIN
  145.   WRITE(CHR(27), CHR(61), CHR(31+row), CHR(31+column));
  146. END;
  147.  
  148.  
  149. PROCEDURE EraseLine(VAR row,column: BYTE);
  150. { Erase current line from cursor to end of line }
  151. BEGIN
  152.   CASE Terminal OF
  153.     ADM, SOROC:
  154.      BEGIN
  155.        PLOT(row,column);
  156.        WRITE( ' ':(80-column+1) );
  157.        PLOT(row,column)
  158.      END;
  159.  
  160.     TVI: BEGIN
  161.        PLOT(row,column);
  162.        WRITE( LineErase )
  163.      END
  164.   END {CASE}
  165. END;
  166.  
  167.  
  168. PROCEDURE CLEAR_ALL;
  169. BEGIN
  170.   EraseLine(f1_line,f1_col);
  171.   EraseLine(f2_line,f2_col);
  172.   EraseLine(f3_line,f3_col);
  173.   EraseLine(f4_line,f4_col);
  174.   EraseLine(f5_line,f5_col);
  175.   EraseLine(f6_line,f6_col);
  176.   EraseLine(f7_line,f7_col);
  177.   EraseLine(f8_line,f8_col);
  178. END;
  179.  
  180. PROCEDURE QUIRY(VAR row, column: BYTE;
  181.         VAR ANSWER: DFLT_STRING);
  182. VAR
  183.   CIX    : CHAR;
  184.   DONE,
  185.   VALID : BOOLEAN;
  186.  
  187. BEGIN
  188.   PLOT(row, column);
  189.   REPEAT
  190.     SETLENGTH(ANSWER,0);
  191.     DONE := FALSE;
  192.     WHILE NOT ( DONE ) DO
  193.       BEGIN
  194.     KEYIN(CIX);
  195.     VALID := ( ORD(CIX)<>ESC_CODE );
  196.     IF NOT ( VALID ) THEN {REDO FROM START}
  197.       BEGIN
  198.         DONE := TRUE;
  199.         SETLENGTH(ANSWER,0);
  200.         EraseLine(row,column);
  201.       END
  202.     ELSE
  203.       IF ( ORD(cix)=NewLine ) THEN
  204.          DONE := TRUE
  205.       ELSE
  206.         BEGIN
  207.           WRITE(CIX);
  208.           APPEND(ANSWER,CIX);
  209.         END;
  210.       END {WHILE};
  211.   UNTIL ( VALID );
  212. END {OF QUIRY};
  213.  
  214.  
  215. PROCEDURE FILLONE(VAR DONE: BOOLEAN);
  216. BEGIN
  217.   PLOT(2,12);WRITELN( INVON, 'RECORD #', CURRENT_RECORD:1, ' ', INVOFF );
  218.   QUIRY(f1_line,f1_col,FULLNAME);
  219.   IF ( LENGTH(FULLNAME) = 0 ) THEN
  220.      DONE := TRUE
  221.     {EXIT(FILLONE); }
  222.   ELSE
  223.     BEGIN
  224.       DONE := FALSE;
  225.       QUIRY(f2_line,f2_col,SALUTE);
  226.       QUIRY(f3_line,f3_col,ADDR1);
  227.       QUIRY(f4_line,f4_col,ADDR2);
  228.       QUIRY(f5_line,f5_col,CITY);
  229.       QUIRY(f6_line,f6_col,STATE);
  230.       QUIRY(f7_line,f7_col,ZIP);
  231.       QUIRY(f8_line,f8_col,CODES)
  232.     END
  233. END {OF FILLONE};
  234.  
  235.  
  236. PROCEDURE WRITE_MASK;
  237. BEGIN
  238.   WRITE( CLEAR, HOME );
  239.   WRITELN;
  240.   WRITELN;
  241.   WRITELN;
  242.   WRITELN;
  243.   WRITELN('FULL NAME: .......');WRITELN;
  244.   WRITELN('SALUTATION: ......');WRITELN;
  245.   WRITELN('ADDRESS LINE 1: ..');WRITELN;
  246.   WRITELN('ADDRESS LINE 2: ..');WRITELN;
  247.   WRITELN('CITY: ............');WRITELN;
  248.   WRITELN('STATE: ...........');WRITELN;
  249.   WRITELN('ZIP: .............');WRITELN;
  250.   WRITELN('CODE(s): .........');
  251. END;
  252.  
  253.  
  254. PROCEDURE INIT;
  255. BEGIN
  256.   Terminal := ADM;    { Select the correct terminal type }
  257.   BELL := CHR(7);
  258.   HOME := CHR(30);    { Home the cursor but do not clear the screen }
  259.   CLEAR := CHR(26);    { Completely clear the terminal screen }
  260.   ESC := CHR(27);
  261.  
  262. {+++++++++++++++++++++++++++++++++++++++++++++++++++}
  263. {+ These string sequences pertain to the Televideo +}
  264. {+ terminal.                       +}
  265. {+++++++++++++++++++++++++++++++++++++++++++++++++++}
  266.     { inverse video ON }
  267.   INVON[1] := ESC;
  268.   INVON[2] := 'j';
  269.     { inverse video OFF }
  270.   INVOFF[1] := ESC;
  271.   INVOFF[2] := 'k';
  272.     { delete the line the cursor is on }
  273.   LineDelete[1] := ESC;
  274.   LineDelete[2] := 'R';
  275.     { erase from the cursor to the end of the line }
  276.   LineErase[1] := ESC;
  277.   LineErase[2] := 't';
  278.     { half intensity ON }
  279.   HintOn[1] := ESC;
  280.   HintOn[2] := ')';
  281.     { half intensity OFF }
  282.   HintOff[1] := ESC;
  283.   HintOff[2] := '(';
  284.  
  285. { f?_line = starting line for field n in the MASK   }
  286. { f?_col  = starting column for field n in the MASK }
  287.   f1_line :=  5;    f1_col := 20;{ FIELD #1 }
  288.   f2_line :=  7;    f2_col := 20;{ FIELD #2 }
  289.   f3_line :=  9;    f3_col := 20;{ FIELD #3 }
  290.   f4_line := 11;    f4_col := 20;{ FIELD #4 }
  291.   f5_line := 13;    f5_col := 20;{ FIELD #5 }
  292.   f6_line := 15;    f6_col := 20;{ FIELD #6 }
  293.   f7_line := 17;    f7_col := 20;{ FIELD #7 }
  294.   f8_line := 19;    f8_col := 20;{ FIELD #8 }
  295. END;
  296.  
  297.  
  298. BEGIN{ Main program NAD entry }
  299.   INIT;
  300.   WRITE( CLEAR );
  301.   { OPEN FILES }
  302.   SETLENGTH(FILENAME,0);
  303.   WRITELN;
  304.   WRITE(' FILE: ');
  305.   READLN(FILENAME);
  306.   APPEND(FILENAME,CHR(13));
  307.   RESET(FILENAME,FOUT);
  308.   {++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  309.   {+  IF FILE ALREADY EXISTS THEN INFORM OPERATOR THAT    +}
  310.   {+  HE WILL DESTROY EXISTING FILE, AND TERMINATE.    +}
  311.   {++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  312.   IF NOT ( EOF(FOUT) ) THEN
  313.     BEGIN
  314.       WRITE( BELL );
  315.       WRITELN
  316.     ( ' ':12,INVON,'        FILE ALREADY EXISTS          ', INVOFF );
  317.       WRITELN
  318.     ( ' ':12,INVON,' THIS PROGRAM WILL DESTROY YOUR FILE ', INVOFF );
  319.     END
  320.   ELSE
  321.     BEGIN
  322.       REWRITE( FILENAME, FOUT);
  323.       WRITELN;
  324.       WRITE('Enter beginning Record No. ');
  325.       READLN(CURRENT_RECORD);
  326.       WRITE_MASK;
  327.       REPEAT
  328.     FILLONE(DONE);
  329.     IF NOT ( DONE ) THEN
  330.       BEGIN
  331.         CLEAR_ALL;
  332.         WRITEONE;
  333.       END;
  334.     CURRENT_RECORD := CURRENT_RECORD + 1
  335.       UNTIL ( DONE );
  336.       WRITE( CLEAR );
  337.     END;
  338. END.{ Program NAD Entry }
  339.