home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 December / simtel1292_SIMTEL_1292_Walnut_Creek.iso / msdos / hamradio / kam401.arc / KAM-LOG.PAS < prev    next >
Pascal/Delphi Source File  |  1989-03-02  |  14KB  |  450 lines
  1. TYPE
  2.     ROUTELIST = RECORD
  3.       Deleted     : boolean;
  4.       name        : string[10];
  5.       routing     : string[30];
  6.       comment     : string[30];
  7.     END;
  8. TYPE
  9.     HAMLOG_record = RECORD
  10.       Deleted     : Boolean;
  11.       _CALLSIGN   : String[ 9];
  12.       _NAME       : String[10];
  13.       _DATE       : String[10];  { Date field }
  14.       _TIME       : String[ 5];
  15.       _FREQ       : Real;        { width= 10 decimals= 5 }
  16.       _POWER      : LongInt;     { width= 4 }
  17.       _MODE       : String[ 3];
  18.       _RST_OUT    : String[ 3];
  19.       _RST_IN     : String[ 3];
  20.       _COMMENT    : String[30];
  21.       _QSL_SENT   : String[10];  { Date field }
  22.       _QSL_RCVD   : String[10];  { Date field }
  23.     END;
  24.     IndxTyp = (CALLSIGN,DATETIME);
  25. VAR
  26.     HAMLOG : HAMLOG_record;
  27.     CallList : ROUTELIST;
  28.     m_CALLSIGN : String;
  29.     FilterValue : String;
  30.     m_Found : Boolean;
  31.     Choice : Char;
  32.     AddMode : Boolean;
  33.     EditMode : Boolean;
  34.     MRecNo : LongInt;
  35.     IndexOn : IndxTyp;
  36.  
  37. PROCEDURE SayGetColors;
  38. begin
  39.   Set_Color_To(14,1,4,7);
  40.   Set_Highlight_To(7,4);
  41. end;
  42.  
  43. PROCEDURE HelpScreen;
  44. { Displays a list of menu commands when <F1> or "H" is pressed }
  45. VAR ScreenBuffer : Array[1..2000] OF Word;
  46. BEGIN
  47.   FillPage(@ScreenBuffer); { save contents of current screen }
  48.   Window(5,4,75,23);
  49.   Set_Color_To(Black,LightGray,Black,LightGray);
  50.   ClrScr;
  51.   WriteLn('                         Menu Commands');
  52.   WriteLn;
  53.   WriteLn('  N - Next      Skips to and displays next record in file');
  54.   WriteLn('  P - Prev      Skips back one and displays prior record');
  55.   WriteLn('  T - Top       Displays first record in file');
  56.   WriteLn('  O - Bottom    Displays last record in file');
  57.   WriteLn('  G - Go        Positions database on selected record by number');
  58.   WriteLn('  F - Find      Finds the first record with matching key field');
  59.   WriteLn('  E - Edit      Allows modification of currently displayed record');
  60.   WriteLn('  A - Add       Allows input and appends a new record into database');
  61.   WriteLn('  D - Delete    Marks or unmarks current record for deletion by Pack');
  62.   WriteLn('  B - Browse    Spreadsheet-like view of database');
  63.   WriteLn('  C - Pack      Purges database of all records marked for deletion');
  64.   WriteLn('  I - Index     Toggle CALLSIGN Index On/Off');
  65.   WriteLn('  Q - Quit      Quit viewing of database');
  66.   WriteLn;
  67.   Wait('                        Press any key to return...');
  68.   full_window;
  69.   DisplayPage(@ScreenBuffer); { restore prior screen }
  70.   SayGetColors;
  71. END;   { HelpScreen }
  72.  
  73.  
  74. {$F+} PROCEDURE EditHelp; { called by SAYGET4.TPU }
  75. { Displays a help screen when <F1> is pressed while editing }
  76. VAR ScreenBuffer : Array[1..2000] OF Word;
  77. BEGIN
  78.   FillPage(@ScreenBuffer); { save contents of current screen }
  79.   Set_Color_To(Black,LightGray,Black,LightGray);
  80.   Window(5,3,75,23);
  81.   ClrScr;
  82.   WriteLn('                          Editing Commands');
  83.   WriteLn;
  84.   WriteLn('      <Ctrl-R> or <PgUp>  Move to beginning of first field');
  85.   WriteLn('      <Ctrl-C>  Move to beginning of last field');
  86.   WriteLn('      <Ctrl-E> or <Up Arrow> Move to beginning of prior field');
  87.   WriteLn('      <Ctrl-X> or <Dn Arrow> Move to beginning of next field');
  88.   WriteLn('      <Ctrl-V> or <Ins>  Toggle insert/overwrite mode');
  89.   WriteLn('      <Ctrl-G> or <Del>  Delete character at cursor');
  90.   WriteLn('      <Ctrl-T>  Delete word to right of cursor ');
  91.   WriteLn('      <Ctrl-Y>  Delete all characters to right of cursor');
  92.   WriteLn('      <Ctrl-U>  Restore prior data (Undo)');
  93.   WriteLn('      <Ctrl-S> or <Lft Arrow> Move cursor left one character');
  94.   WriteLn('      <Ctrl-D> or <Rt Arrow> Move cursor right one character');
  95.   WriteLn('      <Ctrl-W> or <PgDn> Exit edit session');
  96.   WriteLn('      <Esc>     Abandon edit');
  97.   WriteLn('      <Home>    Move cursor to first character in field');
  98.   WriteLn('      <End>     Move cursor to last charcter in field');
  99.   WriteLn;
  100.   Wait('                        Press any key to return...');
  101.   full_window;
  102.   DisplayPage(@ScreenBuffer); { restore prior screen }
  103.   SayGetColors;
  104. END;   { EditHelp }
  105. {$F-}
  106.  
  107.  
  108. {$F+}
  109. FUNCTION CallKey : String; { called by INDEX4.TPU }
  110. BEGIN
  111.   CallKey := Upper(HAMLOG._CALLSIGN);
  112. END;  { CallKey }
  113.  
  114. FUNCTION DateTimeKey : String;
  115. BEGIN
  116. WITH HAMLOG do
  117.   DateTimeKey := _DATE[7] + _DATE[8] +
  118.                  _DATE[1] + _DATE[2] +
  119.                  _DATE[4] + _DATE[5] + _TIME;
  120. END;
  121. {$F-}
  122.  
  123.  
  124. PROCEDURE Find_CALLSIGN; { Direct access via index }
  125. BEGIN
  126.   SayGet(20,25,' Enter CALLSIGN : ',m_CALLSIGN,_S,9,1);
  127.   Picture('@!');
  128.   ReadGets;
  129.   AT(20,25,'═════════════════════════════════════════════');
  130.   IF EditResult > 0 THEN Exit;
  131.   IF Length(M_CALLSIGN) > 0 THEN
  132.   BEGIN
  133.     if IndexOn = DATETIME then Set_Order_To(2);
  134.     Find(m_CALLSIGN);
  135.     IF NOT Found THEN
  136.     BEGIN
  137.       GoToXY(20,25);
  138.       Wait(' ' + m_CALLSIGN + ' not found.  Press any key... ');
  139.       AT(20,25,'═════════════════════════════════════════════');
  140.       GoBottom;
  141.     END;
  142.   END;
  143.   if IndexOn = DATETIME then Set_Order_To(1);
  144. END;   { Find_CALLSIGN }
  145.  
  146. PROCEDURE HamForm;
  147. begin
  148.   AT(1,15,'╔╣Index [ callsign ] ╠═════════════════════════════════════════════════════════╗');
  149.   AT(1,16,'║Record #        of            File                   Last Update :            ║');
  150.   AT(1,17,'╠════════════════════╤═════════════════════╤═════════════════╤═════════════════╣');
  151.   AT(1,18,'║Callsign            │Name                 │Date             │Time             ║');
  152.   AT(1,19,'╟────────────────────┼───────────┬─────────┼─────────────────┼─────────────────╢');
  153.   AT(1,20,'║Freq                │Power      │Mode     │RSTout           │RSTin            ║');
  154.   AT(1,21,'╟────────────────────┴───────────┴─────────┼─────────────────┼─────────────────╢');
  155.   AT(1,22,'║Comment                                   │QSLsent          │QSLrcvd          ║');
  156.   AT(1,23,'╠══════════════════════════════════════════╧═════════════════╧═════════════════╣');
  157.   AT(1,24,'║Next  Prev  Top  bOttom  Go  Find  Edit  Add  Del  Browse  paCk  Index  Quit  ║');
  158.   AT(1,25,'╚╣<F1> = Help╠═════════════════════════════════════════════════════════════════╝');
  159.   AT(37,16,DBF);
  160.   AT(69,16,LUpdate);
  161. end;
  162.  
  163. PROCEDURE DoGetsWith_HAMLOG;
  164. BEGIN
  165.   WITH HAMLOG DO
  166.     BEGIN
  167.       IF AddMode THEN
  168.         BEGIN
  169.           ClearRecord;
  170.           _DATE := SystemDate;
  171.           _TIME := SystemTime;
  172.           AT(11,16,SInteger(RecCount+1,4));
  173.           AT(21,16,SInteger(RecCount+1,4));
  174.         END
  175.       ELSE
  176.         BEGIN
  177.           AT(11,16,SInteger(RecNo,4));
  178.           AT(21,16,SInteger(RecCount,4));
  179.         END;
  180.       IF dBOF OR dEOF THEN RingBell;
  181.  
  182.       SayGet(12,18, '', _CALLSIGN, _S, 9, 0);
  183.         Picture('@!');
  184.       SayGet(29,18, '', _NAME, _S, 10, 0);
  185.       SayGet(51,18, '', _DATE, _D, 8, 0);
  186.       SayGet(68,18, '', _TIME, _S, 5, 0);
  187.         Picture('99:99');
  188.       SayGet( 8,20, '', _FREQ, _R, 10, 5);
  189.       SayGet(29,20, '', _POWER, _LI, 4, 0);
  190.       SayGet(40,20, '', _MODE, _S, 3, 0);
  191.         Picture('@!');
  192.       SayGet(52,20, '', _RST_OUT, _S, 3, 0);
  193.       SayGet(69,20, '', _RST_IN, _S, 3, 0);
  194.       SayGet(12,22, '', _COMMENT, _S, 30, 0);
  195.       SayGet(53,22, '', _QSL_SENT, _D, 8, 0);
  196.       SayGet(71,22, '', _QSL_RCVD, _D, 8, 0);
  197.  
  198.       IF deleted THEN AT(65,25,'╣ DELETED ╠')
  199.                  ELSE AT(65,25,'═══════════');
  200.  
  201.       IF EditMode OR AddMode THEN
  202.         BEGIN
  203.           ReadGets;  { edit the fields defined with SayGet() }
  204.           IF EditResult <= 0 THEN
  205.             IF AddMode
  206.               THEN Append
  207.               ELSE Replace;
  208.         END
  209.       ELSE ClearGets; { just display the fields }
  210.     END;
  211. END;       { DoGetsWith_HAMLOG }
  212.  
  213. procedure makedatabase;
  214. var FieldList : FieldArray;
  215.     database : dbfRECORD;
  216. begin
  217.   FillChar(FieldList,SizeOf(FieldList), 0);
  218.  
  219.   FieldList[1].Name := 'CALLSIGN'; { field Name }
  220.   FieldList[1].Typ := 'C';         { field Type }
  221.   FieldList[1].Len := 9;           { field Width }
  222.  
  223.   FieldList[2].Name := 'NAME';
  224.   FieldList[2].Typ := 'C';
  225.   FieldList[2].Len := 10;
  226.  
  227.   FieldList[3].Name := 'DATE';
  228.   FieldList[3].Typ  := 'D';
  229.  
  230.   FieldList[4].Name := 'TIME';
  231.   FieldList[4].Typ  := 'C';
  232.   FieldList[4].Len  := 5;
  233.  
  234.   FieldList[5].Name := 'FREQ';
  235.   FieldList[5].Typ  := 'N';
  236.   FieldList[5].Len  := 10;
  237.   FieldList[5].Dec  := 5;
  238.  
  239.   FieldList[6].Name := 'POWER';
  240.   FieldList[6].Typ  := 'N';
  241.   FieldList[6].Len  := 4;
  242.  
  243.   FieldList[7].Name := 'MODE';
  244.   FieldList[7].Typ  := 'C';
  245.   FieldList[7].Len  := 3;
  246.  
  247.   FieldList[8].Name := 'RST_OUT';
  248.   FieldList[8].Typ  := 'C';
  249.   FieldList[8].Len  := 3;
  250.  
  251.   FieldList[9].Name := 'RST_IN';
  252.   FieldList[9].Typ  := 'C';
  253.   FieldList[9].Len  := 3;
  254.  
  255.   FieldList[10].Name := 'COMMENT';
  256.   FieldList[10].Typ  := 'C';
  257.   FieldList[10].Len  := 30;
  258.  
  259.   FieldList[11].Name := 'QSL_SENT';
  260.   FieldList[11].Typ  := 'D';
  261.  
  262.   FieldList[12].Name := 'QSL_RCVD';
  263.   FieldList[12].Typ  := 'D';
  264.  
  265.   CreateDBF(database,kam_log_file+'.DBF',12,@FieldList);
  266.   USE(kam_log_file+'.DBF', @HAMLOG, SizeOf(HAMLOG)); { open the file }
  267.   ClearRecord;
  268.   Append;
  269. end;
  270.  
  271. procedure MakeCallList;
  272. var FieldList : FieldArray;
  273.     database : dbfRECORD;
  274. begin
  275.   FillChar(FieldList,SizeOf(FieldList), 0);
  276.  
  277.   FieldList[1].Name := 'NAME'; { field Name }
  278.   FieldList[1].Typ := 'C';         { field Type }
  279.   FieldList[1].Len := 10;           { field Width }
  280.  
  281.   FieldList[2].Name := 'ROUTING';
  282.   FieldList[2].Typ := 'C';
  283.   FieldList[2].Len := 30;
  284.  
  285.   FieldList[3].Name := 'COMMENT';
  286.   FieldList[3].Typ := 'C';
  287.   FieldList[3].Len := 30;
  288.  
  289.   CreateDBF(database,'CALLLIST.DBF',3,@FieldList);
  290.   USE('CALLLIST.DBF', @CALLLIST, SizeOf(CALLLIST)); { open the file }
  291.   ClearRecord;
  292.   Append;
  293. end;
  294.  
  295. PROCEDURE OpenIndexes;
  296. begin
  297.   Set_Index_To(@DateTimeKey,kam_log_file+'.DTM',1);
  298.   Set_Index_To(@CallKey,kam_log_file+ '.CLL',2);
  299.   IndexOn := DATETIME;
  300.   Set_Order_To(1);
  301. end;
  302.  
  303. PROCEDURE MakeIndexes;
  304. begin
  305.   WriteLn('Indexing HAMLOG on date/time ...');
  306.   Index_On(@DateTimeKey, kam_log_file+'.DTM');
  307.   CloseIndexes;
  308.   WriteLn('Indexing HAMLOG on callsign ...');
  309.   Index_On(@CallKey, kam_log_file+'.CLL');
  310.   CloseIndexes;
  311. end;
  312.  
  313. PROCEDURE InitializeDataBase;
  314. BEGIN
  315.   Set_Escape_On;   { affects SayGet commands }
  316.   Set_Safety_Off;  { affects Pack command }
  317.   SayGetColors;
  318.   Select(1);       { choose a work area in which to open the database }
  319.  
  320.   IF NOT FileExists(kam_log_file+'.DBF')
  321.     THEN makedatabase
  322.     ELSE USE(kam_log_file+'.DBF', @HAMLOG, SizeOf(HAMLOG)); { open the file }
  323.  
  324.   IF NOT FileExists(kam_log_file+'.DTM') THEN
  325.     MakeIndexes;
  326.  
  327.   Select(1);
  328.   OpenIndexes;
  329.  
  330.   EditMode := False;
  331.   AddMode  := False;
  332.   m_CALLSIGN := '';
  333.  
  334.   Select(2);
  335.   If NOT FileExists('CALLLIST.DBF')
  336.     then MakeCallList
  337.     else USE('CALLLIST.DBF',@CALLLIST,SizeOf(CALLLIST));
  338.  
  339. END;  { Initialization }
  340.  
  341. procedure ToggleIndex;
  342. begin
  343.   case IndexOn of
  344.     CALLSIGN : begin
  345.                  Set_Order_To(1);
  346.                  IndexOn := DATETIME;
  347.                end;
  348.     DATETIME : begin
  349.                  Set_Order_To(2);
  350.                  IndexOn := CALLSIGN;
  351.                end;
  352.   end;
  353. end;
  354.  
  355.  
  356. procedure HAMLOG_MENU;
  357. var  MainScreenBuffer : Array[1..2000] OF Word;
  358. begin
  359.   Select(1);
  360.   Set_FKey(F1, @EditHelp);
  361.   Set_Cursor_Off;
  362.   HamForm;
  363.   REPEAT
  364.     DoGetsWith_HAMLOG;  { display (or edit) the current record }
  365.     case IndexOn of
  366.       CALLSIGN : AT(10,15,' CALLSIGN ');
  367.       DATETIME : AT(10,15,' DATETIME ');
  368.     end;
  369.     REPEAT
  370.       Choice := ReadKey;       { get user request }
  371.       IF Choice = CHR(0) THEN  { user pressed a special key }
  372.         BEGIN
  373.          Choice := ReadKey;
  374.           Case Choice Of
  375.             'P' : Choice := 'N';  { map down-arrow to "Next"   }
  376.             'H' : Choice := 'P';  { map up-arrow to "Previous" }
  377.             ';' : Choice := 'H';  { map F1 to "Help" }
  378.             ELSE Choice := ' ';   { ignore other special keys  }
  379.           END;
  380.         END;
  381.       Choice := UpCase(Choice);
  382.     UNTIL POS(Choice,'NPTOGFEADHBCIQ') > 0;
  383.     EditMode := False;
  384.     AddMode  := False;
  385.     CASE Choice OF
  386.       'N' : BEGIN
  387.               Skip(1);
  388.               IF dEOF THEN GoBottom;
  389.             END;
  390.       'P' : Skip(-1);
  391.       'E' : EditMode := True;
  392.       'A' : AddMode  := True;
  393.       'H' : HelpScreen;
  394.       'D' : { toggle the "Deleted" flag }
  395.             IF HAMLOG.Deleted THEN RecallRec ELSE DeleteRec;
  396.       'T' : GoTop;     { position database at first record according to index }
  397.       'O' : GoBottom;  { position database at last record according to index }
  398.       'B' : begin
  399.               FillPage(@MainScreenBuffer);
  400.               Set_BrowseWindow_To(1,1,80,14,0,'');
  401.               Browse('NOMODIFY');
  402.               DisplayPage(@MainScreenBuffer);
  403.             end;
  404.       'F' : Find_CALLSIGN;    { user defined }
  405.       'G' : BEGIN  { GO }
  406.               MRecNO := 1;
  407.               SayGet(10,25,' Enter record number: ',MRecNo,_LI,6,0);
  408.               Range('1',SInteger(RecCount,0));
  409.               Set_Repaint_Off;
  410.               ReadGets;
  411.               Set_Repaint_On;
  412.               IF EditResult <= 0 THEN GO(MRecNo);
  413.               AT(10,25,'═════════════════════════════');
  414.              END;
  415.       'C' : BEGIN  { Pack }
  416.               FillPage(@MainScreenBuffer);
  417.               ClrScr;
  418.               WriteLn('Removing deleted records...');
  419.               Set_Talk_On;
  420.               Pack;
  421.               MakeIndexes;
  422.               OpenIndexes;
  423.               GoTop;
  424.               DisplayPage(@MainScreenBuffer);
  425.              END;
  426.       'I' : ToggleIndex;
  427.     END; { Case }
  428.   UNTIL choice = 'Q';
  429.   Set_Cursor_On;
  430. end;
  431.  
  432. procedure log_qso;
  433. begin
  434.   halt_xmt;
  435.   save_screen;
  436.   HAMLOG_MENU;
  437.   restore_screen;
  438. end;
  439.  
  440. procedure MaintainCallList;
  441. var  MainScreenBuffer : Array[1..2000] OF Word;
  442. begin
  443.   Select(2);
  444.   FillPage(@MainScreenBuffer);
  445.   Set_BrowseWindow_To(1,1,80,15,2,'');
  446.   Browse('');
  447.   DisplayPage(@MainScreenBuffer);
  448.   PKCall := CALLLIST.ROUTING;
  449. end;
  450.