home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / asm_sour / module.pas < prev    next >
Pascal/Delphi Source File  |  1984-06-09  |  9KB  |  242 lines
  1. {  $LIST+, $DEBUG+, $BRAVE+, $LINESIZE:132, $PAGESIZE:80, $OCODE+   }
  2. {  $ERRORS:50, $MATHCK+, $RANGECK+, $INITCK+, $INDEXCK+, $ENTRY+    }
  3. {  $LINE+, $RUNTIME+, $SYMTAB+, $WARN+, $GOTO-     }
  4. {  $TITLE:'Record Handler  ---  AEM$SCRATCH'             }
  5. {  $MESSAGE:'PASCAL - COMPILATION OPTIONS SET'     }
  6. {  $MESSAGE:'SYSTEM - COMPILATION BEGINS'          }
  7.  
  8. module file_aux_code;
  9.  
  10. const
  11.    maxname =   20;
  12.    maxstrg =   30;
  13.    blank   =   ' ';
  14.  
  15. type
  16.    s10         =   string(10);
  17.    stindex     =   byte;
  18.    idxrng      =   0..30;
  19.    varstrng    =   lstring(maxname);
  20.    fixstrng    =   string(maxname);
  21.    maxstrng    =   string(maxstrg);
  22.    maxlstrng   =   lstring(maxstrg);
  23.  
  24.    entrytype   =   record
  25.        name    :   record
  26.            lastname, firstname : fixstrng;
  27.            midinit : char
  28.        end;
  29.        addr    :   record
  30.            street  : maxstrng;
  31.            city    : fixstrng;
  32.            state   : string (2);
  33.            zip     : string(5)
  34.        end;
  35.        phone   :   record
  36.            number  : string(8);
  37.            areacod : string(3)
  38.        end;
  39.        dob : string(8)
  40.    end;
  41.  
  42.    nodeptr     =   ^node;
  43.    node    = record
  44.        entry :  entrytype;
  45.        next : nodeptr
  46.    end;
  47.  
  48. var [static,public]
  49.    curtime, curdate : s10;
  50.  
  51. procedure cls; extern;
  52. procedure time (var s: string); extern;
  53. procedure date (var s: string); extern;
  54. procedure locate (row, column : integer) ;extern;
  55. procedure beep; extern;
  56. procedure lookup (const key:entrytype;var current,previous:nodeptr;
  57.                   const hol:nodeptr;var found : boolean);extern;
  58. procedure keyboard (var destination : string; var length:idxrng; width:integer); extern;
  59.  
  60. procedure recdisp (const curdisp : nodeptr; const reccount : integer);
  61.  
  62.    var
  63.     i : idxrng;
  64.       recname : fixstrng;
  65.    begin
  66.        recname := curdisp^.entry.name.lastname;
  67.        for i := 1 to 20 do
  68.            if recname [i] in ['a'..'z'] then
  69.                recname [i] := chr(ord(recname[i]) - 32);
  70.        cls;
  71.        locate (1,1);   time (curtime);  date (curdate);
  72.        write (output, 'Page:  DISPLAY', null : 4, 'Primary key cannot be modified');
  73.        locate (2,1); write (output, 'Time: ', curtime, null:3, 'Date: ', curdate);
  74.        locate (4,1);    write (output, '*Current Record: ', recname);
  75.        with curdisp^.entry do
  76.            begin
  77.                locate (6,1); write (output, 'First Name: ', name.firstname);
  78.                locate (6,40); write (output, 'Middle Initial: ', name.midinit);
  79.                locate (7,1); write (output, 'Last Name: ', name.lastname);
  80.                locate (9,1); write (output, 'Address:');
  81.                locate (11, 1); write (output, 'Street: ', addr.street);
  82.                locate (12, 1); write (output, 'City: ', addr.city);
  83.                locate (12,41); write (output, 'State: ', addr.state);
  84.                locate (12,56); write (output, 'Zip code: ', addr.zip);
  85.                locate (14,1); write (output, 'Area code: ', phone.areacod);
  86.                locate (14, 17); write (output, 'Phone: ', phone.number);
  87.                locate (16,1); write (output, 'Birthday: ', dob)
  88.            end;
  89.        locate (20,1); write (output, 'Last name cannot be modified');
  90.        locate (22,1); write (output, 'Type the new value, or <RETURN> for no change');
  91.    end;
  92. procedure view (const hol : nodeptr);
  93.  
  94. var
  95.    viewrec : entrytype;
  96.    current,previous : nodeptr;
  97.    found : boolean;
  98.    length, i : idxrng;
  99. begin
  100.    cls;
  101.    time (curtime);  date (curdate);
  102.    locate (1,1); write (output, 'Time: ', curtime, null:3, 'Date: ', curdate);
  103.    locate (4,1); write (output, 'Type LAST name of record to view -->');
  104.    locate (4,38); for i := 1 to 20 do write (output, '.');
  105.     locate (4,38);
  106.    keyboard (viewrec.name.lastname, length, 20);  locate (4,38);
  107.    for i := length + 1 to 20 do [ viewrec.name.lastname[i] := blank; write (output, blank) ];
  108.    lookup (viewrec,current,previous,hol,found);
  109.    if found then
  110.        recdisp (current,01)
  111.    else
  112.        begin
  113.            cls;
  114.            locate (4,1); writeln;
  115.            writeln (output, '*Requested record (', viewrec.name.lastname, ')  NOT found');
  116.            writeln; writeln (output, 'Strike any key to proceed to primary options...');
  117.            keyboard (viewrec.name.lastname,length,1);
  118.            return
  119.        end;
  120.     locate (20,1); write (output, null: 70);
  121.     locate (22,1); write (output, null: 70);
  122.     locate (23,1); write (output, null: 60);
  123.     locate (23,1); write (output, 'Strike any key to return to primary options');
  124.     keyboard (viewrec.name.lastname,length,1)
  125. end; {procedure}
  126. procedure getdata (var newrecord : entrytype);
  127.  
  128. label
  129.    1, 2;
  130. var
  131.    length, i : idxrng;
  132.    tempstring : maxstrng;
  133.    index : integer;
  134.    reply :char;
  135.  
  136.    procedure pad (var s : string; curlen, maxlen : idxrng);
  137.    var index : idxrng;
  138.    begin   { pad }
  139.        if curlen < maxlen then
  140.            for index := curlen+1 to maxlen do
  141.                s [index] := blank
  142.    end;  {pad}
  143. begin   {insert information into record and exit back to primary}
  144. 1: cls;
  145.    time (curtime);  date (curdate);
  146.    locate (2,1);
  147.    write (output, 'Time: ',curtime, '   Date: ', curdate);
  148.    locate (1,1);   write ('Add Record:');
  149.    locate (1,23);  write ('Data Entry:');
  150.    locate (1,70);  write ('*NEW*');
  151.    locate (3,1);
  152.    for index := 1 to 79 do write ('-');
  153.    locate (5,1);   write ('Last Name:');
  154.    locate (5,12);  for i := 1 to 20 do write ('.');
  155.    locate (5,40);  write ('Middle Initial:');
  156.    locate (5,56);  write ('.');
  157.    locate (7,1);   write ('First Name:');
  158.    locate (7,13);  for i := 1 to 20 do write ('.');
  159.    locate (7,40);  write ('D.O.B.:');
  160.    locate (7,48);  write ('../../..');
  161.    locate (9,1);   write ('Street:');
  162.    locate (9,9);   for i := 1 to 30 do write ('.');
  163.    locate (11,1);  write ('City:');
  164.    locate (11,7);  for i := 1 to 20 do write ('.');
  165.    locate (11,33); write ('State:');
  166.    locate (11,41); write ('..');
  167.    locate (11,46); write ('Zip Code:');
  168.    locate (11,56); write ('.....');
  169.    locate (13,1);  write ('Phone:');
  170.    locate (13,09);  write ('...-....');
  171.    locate (13,21); write ('Area Code:');
  172.    locate (13,32); write ('(...)');
  173. {now get the actual data items input with keyboard}
  174.    with newrecord do
  175.        begin
  176.            locate (5,12);
  177.            keyboard (name.lastname, length, 20);
  178.            pad (name.lastname,length,20);
  179.            beep;
  180.            for i := length+1 to 20 do write (output,blank);
  181.            locate (5,56);  keyboard (name.midinit,length,1);
  182.            beep;
  183.            locate (7,13);
  184.            keyboard (name.firstname, length, 20);
  185.            pad (name.firstname,length,20);
  186.            beep;
  187.            for i := length+1 to 20 do write (output, blank);
  188.            locate (7,48);
  189.            keyboard (dob, length, 08);
  190.            pad (dob,length,08);
  191.            beep;
  192.            for i := length+1 to 10 do write(output, blank);
  193.            locate (9,9);
  194.            keyboard (addr.street, length, 30);
  195.            pad (addr.street,length,30);
  196.            beep;
  197.            for i := length+1 to 30 do write (output,blank);
  198.            locate (11,7);
  199.            keyboard (addr.city, length, 20);
  200.            pad (addr.city,length,20);
  201.            beep;
  202.            for i := length+1 to 20 do write (output, blank);
  203.            locate (11,41);
  204.            keyboard (addr.state, length, 02);
  205.            pad (addr.state,length,02);
  206.            beep;
  207.            for i := length+1 to 2 do write (output, blank);
  208.            locate (11, 56);
  209.            keyboard (addr.zip, length, 5);
  210.            pad (addr.zip,length,5);
  211.            beep;
  212.            for i := length+1 to 5 do write (output, blank);
  213.            locate (13,09);
  214.            keyboard (phone.number, length, 8);
  215.            pad(phone.number,length,8);
  216.            beep;
  217.            for i := length+1 to 8 do write (output, blank);
  218.            locate (13,33);
  219.            keyboard (phone.areacod, length, 3);
  220.            pad(phone.areacod,length,3);
  221.            for i := length+1 to 3 do write (output, blank);
  222.            beep
  223.        end;
  224. 2: locate (22,1);     write (null : 60);
  225.    locate (20,1);
  226.    write (output, 'Is this record correct?  ');
  227.    keyboard (reply,length,1);
  228.    if (reply = 'N') or (reply = 'n') then
  229.        goto 1
  230.    else
  231.       if (reply = 'y') or (reply = 'Y') then
  232.            return     {go back to caller}
  233.    else      {reply was bad}
  234.        begin
  235.            locate (22,1);
  236.            write (output, '*Bad reply -- restart - key <ENTER>');
  237.            keyboard (reply, i, 1);
  238.            goto 2
  239.        end
  240. end;  {procedure for data entry}
  241. end.  {module}
  242.