TYPE
    ROUTELIST = RECORD
      Deleted     : boolean;
      name        : string[10];
      routing     : string[30];
      comment     : string[30];
    END;
TYPE
    HAMLOG_record = RECORD
      Deleted     : Boolean;
      _CALLSIGN   : String[ 9];
      _NAME       : String[10];
      _DATE       : String[10];  { Date field }
      _TIME       : String[ 5];
      _FREQ       : Real;        { width= 10 decimals= 5 }
      _POWER      : LongInt;     { width= 4 }
      _MODE       : String[ 3];
      _RST_OUT    : String[ 3];
      _RST_IN     : String[ 3];
      _COMMENT    : String[30];
      _QSL_SENT   : String[10];  { Date field }
      _QSL_RCVD   : String[10];  { Date field }
    END;
    IndxTyp = (CALLSIGN,DATETIME);
VAR
    HAMLOG : HAMLOG_record;
    CallList : ROUTELIST;
    m_CALLSIGN : String;
    FilterValue : String;
    m_Found : Boolean;
    Choice : Char;
    AddMode : Boolean;
    EditMode : Boolean;
    MRecNo : LongInt;
    IndexOn : IndxTyp;

PROCEDURE SayGetColors;
begin
  Set_Color_To(14,1,4,7);
  Set_Highlight_To(7,4);
end;

PROCEDURE HelpScreen;
{ Displays a list of menu commands when <F1> or "H" is pressed }
VAR ScreenBuffer : Array[1..2000] OF Word;
BEGIN
  FillPage(@ScreenBuffer); { save contents of current screen }
  Window(5,4,75,23);
  Set_Color_To(Black,LightGray,Black,LightGray);
  ClrScr;
  WriteLn('                         Menu Commands');
  WriteLn;
  WriteLn('  N - Next      Skips to and displays next record in file');
  WriteLn('  P - Prev      Skips back one and displays prior record');
  WriteLn('  T - Top       Displays first record in file');
  WriteLn('  O - Bottom    Displays last record in file');
  WriteLn('  G - Go        Positions database on selected record by number');
  WriteLn('  F - Find      Finds the first record with matching key field');
  WriteLn('  E - Edit      Allows modification of currently displayed record');
  WriteLn('  A - Add       Allows input and appends a new record into database');
  WriteLn('  D - Delete    Marks or unmarks current record for deletion by Pack');
  WriteLn('  B - Browse    Spreadsheet-like view of database');
  WriteLn('  C - Pack      Purges database of all records marked for deletion');
  WriteLn('  I - Index     Toggle CALLSIGN Index On/Off');
  WriteLn('  Q - Quit      Quit viewing of database');
  WriteLn;
  Wait('                        Press any key to return...');
  full_window;
  DisplayPage(@ScreenBuffer); { restore prior screen }
  SayGetColors;
END;   { HelpScreen }


{$F+} PROCEDURE EditHelp; { called by SAYGET4.TPU }
{ Displays a help screen when <F1> is pressed while editing }
VAR ScreenBuffer : Array[1..2000] OF Word;
BEGIN
  FillPage(@ScreenBuffer); { save contents of current screen }
  Set_Color_To(Black,LightGray,Black,LightGray);
  Window(5,3,75,23);
  ClrScr;
  WriteLn('                          Editing Commands');
  WriteLn;
  WriteLn('      <Ctrl-R> or <PgUp>  Move to beginning of first field');
  WriteLn('      <Ctrl-C>  Move to beginning of last field');
  WriteLn('      <Ctrl-E> or <Up Arrow> Move to beginning of prior field');
  WriteLn('      <Ctrl-X> or <Dn Arrow> Move to beginning of next field');
  WriteLn('      <Ctrl-V> or <Ins>  Toggle insert/overwrite mode');
  WriteLn('      <Ctrl-G> or <Del>  Delete character at cursor');
  WriteLn('      <Ctrl-T>  Delete word to right of cursor ');
  WriteLn('      <Ctrl-Y>  Delete all characters to right of cursor');
  WriteLn('      <Ctrl-U>  Restore prior data (Undo)');
  WriteLn('      <Ctrl-S> or <Lft Arrow> Move cursor left one character');
  WriteLn('      <Ctrl-D> or <Rt Arrow> Move cursor right one character');
  WriteLn('      <Ctrl-W> or <PgDn> Exit edit session');
  WriteLn('      <Esc>     Abandon edit');
  WriteLn('      <Home>    Move cursor to first character in field');
  WriteLn('      <End>     Move cursor to last charcter in field');
  WriteLn;
  Wait('                        Press any key to return...');
  full_window;
  DisplayPage(@ScreenBuffer); { restore prior screen }
  SayGetColors;
END;   { EditHelp }
{$F-}


{$F+}
FUNCTION CallKey : String; { called by INDEX4.TPU }
BEGIN
  CallKey := Upper(HAMLOG._CALLSIGN);
END;  { CallKey }

FUNCTION DateTimeKey : String;
BEGIN
WITH HAMLOG do
  DateTimeKey := _DATE[7] + _DATE[8] +
                 _DATE[1] + _DATE[2] +
                 _DATE[4] + _DATE[5] + _TIME;
END;
{$F-}


PROCEDURE Find_CALLSIGN; { Direct access via index }
BEGIN
  SayGet(20,25,' Enter CALLSIGN : ',m_CALLSIGN,_S,9,1);
  Picture('@!');
  ReadGets;
  AT(20,25,'ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ');
  IF EditResult > 0 THEN Exit;
  IF Length(M_CALLSIGN) > 0 THEN
  BEGIN
    if IndexOn = DATETIME then Set_Order_To(2);
    Find(m_CALLSIGN);
    IF NOT Found THEN
    BEGIN
      GoToXY(20,25);
      Wait(' ' + m_CALLSIGN + ' not found.  Press any key... ');
      AT(20,25,'ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ');
      GoBottom;
    END;
  END;
  if IndexOn = DATETIME then Set_Order_To(1);
END;   { Find_CALLSIGN }

PROCEDURE HamForm;
begin
  AT(1,15,'ɹIndex [ callsign ] ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»');
  AT(1,16,'ºRecord #        of            File                   Last Update :            º');
  AT(1,17,'ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹');
  AT(1,18,'ºCallsign            ³Name                 ³Date             ³Time             º');
  AT(1,19,'ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ');
  AT(1,20,'ºFreq                ³Power      ³Mode     ³RSTout           ³RSTin            º');
  AT(1,21,'ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ');
  AT(1,22,'ºComment                                   ³QSLsent          ³QSLrcvd          º');
  AT(1,23,'ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹');
  AT(1,24,'ºNext  Prev  Top  bOttom  Go  Find  Edit  Add  Del  Browse  paCk  Index  Quit  º');
  AT(1,25,'ȹ<F1> = HelpÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ');
  AT(37,16,DBF);
  AT(69,16,LUpdate);
end;

PROCEDURE DoGetsWith_HAMLOG;
BEGIN
  WITH HAMLOG DO
    BEGIN
      IF AddMode THEN
        BEGIN
          ClearRecord;
          _DATE := SystemDate;
          _TIME := SystemTime;
          AT(11,16,SInteger(RecCount+1,4));
          AT(21,16,SInteger(RecCount+1,4));
        END
      ELSE
        BEGIN
          AT(11,16,SInteger(RecNo,4));
          AT(21,16,SInteger(RecCount,4));
        END;
      IF dBOF OR dEOF THEN RingBell;

      SayGet(12,18, '', _CALLSIGN, _S, 9, 0);
        Picture('@!');
      SayGet(29,18, '', _NAME, _S, 10, 0);
      SayGet(51,18, '', _DATE, _D, 8, 0);
      SayGet(68,18, '', _TIME, _S, 5, 0);
        Picture('99:99');
      SayGet( 8,20, '', _FREQ, _R, 10, 5);
      SayGet(29,20, '', _POWER, _LI, 4, 0);
      SayGet(40,20, '', _MODE, _S, 3, 0);
        Picture('@!');
      SayGet(52,20, '', _RST_OUT, _S, 3, 0);
      SayGet(69,20, '', _RST_IN, _S, 3, 0);
      SayGet(12,22, '', _COMMENT, _S, 30, 0);
      SayGet(53,22, '', _QSL_SENT, _D, 8, 0);
      SayGet(71,22, '', _QSL_RCVD, _D, 8, 0);

      IF deleted THEN AT(65,25,'¹ DELETED Ì')
                 ELSE AT(65,25,'ÍÍÍÍÍÍÍÍÍÍÍ');

      IF EditMode OR AddMode THEN
        BEGIN
          ReadGets;  { edit the fields defined with SayGet() }
          IF EditResult <= 0 THEN
            IF AddMode
              THEN Append
              ELSE Replace;
        END
      ELSE ClearGets; { just display the fields }
    END;
END;       { DoGetsWith_HAMLOG }

procedure makedatabase;
var FieldList : FieldArray;
    database : dbfRECORD;
begin
  FillChar(FieldList,SizeOf(FieldList), 0);

  FieldList[1].Name := 'CALLSIGN'; { field Name }
  FieldList[1].Typ := 'C';         { field Type }
  FieldList[1].Len := 9;           { field Width }

  FieldList[2].Name := 'NAME';
  FieldList[2].Typ := 'C';
  FieldList[2].Len := 10;

  FieldList[3].Name := 'DATE';
  FieldList[3].Typ  := 'D';

  FieldList[4].Name := 'TIME';
  FieldList[4].Typ  := 'C';
  FieldList[4].Len  := 5;

  FieldList[5].Name := 'FREQ';
  FieldList[5].Typ  := 'N';
  FieldList[5].Len  := 10;
  FieldList[5].Dec  := 5;

  FieldList[6].Name := 'POWER';
  FieldList[6].Typ  := 'N';
  FieldList[6].Len  := 4;

  FieldList[7].Name := 'MODE';
  FieldList[7].Typ  := 'C';
  FieldList[7].Len  := 3;

  FieldList[8].Name := 'RST_OUT';
  FieldList[8].Typ  := 'C';
  FieldList[8].Len  := 3;

  FieldList[9].Name := 'RST_IN';
  FieldList[9].Typ  := 'C';
  FieldList[9].Len  := 3;

  FieldList[10].Name := 'COMMENT';
  FieldList[10].Typ  := 'C';
  FieldList[10].Len  := 30;

  FieldList[11].Name := 'QSL_SENT';
  FieldList[11].Typ  := 'D';

  FieldList[12].Name := 'QSL_RCVD';
  FieldList[12].Typ  := 'D';

  CreateDBF(database,kam_log_file+'.DBF',12,@FieldList);
  USE(kam_log_file+'.DBF', @HAMLOG, SizeOf(HAMLOG)); { open the file }
  ClearRecord;
  Append;
end;

procedure MakeCallList;
var FieldList : FieldArray;
    database : dbfRECORD;
begin
  FillChar(FieldList,SizeOf(FieldList), 0);

  FieldList[1].Name := 'NAME'; { field Name }
  FieldList[1].Typ := 'C';         { field Type }
  FieldList[1].Len := 10;           { field Width }

  FieldList[2].Name := 'ROUTING';
  FieldList[2].Typ := 'C';
  FieldList[2].Len := 30;

  FieldList[3].Name := 'COMMENT';
  FieldList[3].Typ := 'C';
  FieldList[3].Len := 30;

  CreateDBF(database,'CALLLIST.DBF',3,@FieldList);
  USE('CALLLIST.DBF', @CALLLIST, SizeOf(CALLLIST)); { open the file }
  ClearRecord;
  Append;
end;

PROCEDURE OpenIndexes;
begin
  Set_Index_To(@DateTimeKey,kam_log_file+'.DTM',1);
  Set_Index_To(@CallKey,kam_log_file+ '.CLL',2);
  IndexOn := DATETIME;
  Set_Order_To(1);
end;

PROCEDURE MakeIndexes;
begin
  WriteLn('Indexing HAMLOG on date/time ...');
  Index_On(@DateTimeKey, kam_log_file+'.DTM');
  CloseIndexes;
  WriteLn('Indexing HAMLOG on callsign ...');
  Index_On(@CallKey, kam_log_file+'.CLL');
  CloseIndexes;
end;

PROCEDURE InitializeDataBase;
BEGIN
  Set_Escape_On;   { affects SayGet commands }
  Set_Safety_Off;  { affects Pack command }
  SayGetColors;
  Select(1);       { choose a work area in which to open the database }

  IF NOT FileExists(kam_log_file+'.DBF')
    THEN makedatabase
    ELSE USE(kam_log_file+'.DBF', @HAMLOG, SizeOf(HAMLOG)); { open the file }

  IF NOT FileExists(kam_log_file+'.DTM') THEN
    MakeIndexes;

  Select(1);
  OpenIndexes;

  EditMode := False;
  AddMode  := False;
  m_CALLSIGN := '';

  Select(2);
  If NOT FileExists('CALLLIST.DBF')
    then MakeCallList
    else USE('CALLLIST.DBF',@CALLLIST,SizeOf(CALLLIST));

END;  { Initialization }

procedure ToggleIndex;
begin
  case IndexOn of
    CALLSIGN : begin
                 Set_Order_To(1);
                 IndexOn := DATETIME;
               end;
    DATETIME : begin
                 Set_Order_To(2);
                 IndexOn := CALLSIGN;
               end;
  end;
end;


procedure HAMLOG_MENU;
var  MainScreenBuffer : Array[1..2000] OF Word;
begin
  Select(1);
  Set_FKey(F1, @EditHelp);
  Set_Cursor_Off;
  HamForm;
  REPEAT
    DoGetsWith_HAMLOG;  { display (or edit) the current record }
    case IndexOn of
      CALLSIGN : AT(10,15,' CALLSIGN ');
      DATETIME : AT(10,15,' DATETIME ');
    end;
    REPEAT
      Choice := ReadKey;       { get user request }
      IF Choice = CHR(0) THEN  { user pressed a special key }
        BEGIN
         Choice := ReadKey;
          Case Choice Of
            'P' : Choice := 'N';  { map down-arrow to "Next"   }
            'H' : Choice := 'P';  { map up-arrow to "Previous" }
            ';' : Choice := 'H';  { map F1 to "Help" }
            ELSE Choice := ' ';   { ignore other special keys  }
          END;
        END;
      Choice := UpCase(Choice);
    UNTIL POS(Choice,'NPTOGFEADHBCIQ') > 0;
    EditMode := False;
    AddMode  := False;
    CASE Choice OF
      'N' : BEGIN
              Skip(1);
              IF dEOF THEN GoBottom;
            END;
      'P' : Skip(-1);
      'E' : EditMode := True;
      'A' : AddMode  := True;
      'H' : HelpScreen;
      'D' : { toggle the "Deleted" flag }
            IF HAMLOG.Deleted THEN RecallRec ELSE DeleteRec;
      'T' : GoTop;     { position database at first record according to index }
      'O' : GoBottom;  { position database at last record according to index }
      'B' : begin
              FillPage(@MainScreenBuffer);
              Set_BrowseWindow_To(1,1,80,14,0,'');
              Browse('NOMODIFY');
              DisplayPage(@MainScreenBuffer);
            end;
      'F' : Find_CALLSIGN;    { user defined }
      'G' : BEGIN  { GO }
              MRecNO := 1;
              SayGet(10,25,' Enter record number: ',MRecNo,_LI,6,0);
              Range('1',SInteger(RecCount,0));
              Set_Repaint_Off;
              ReadGets;
              Set_Repaint_On;
              IF EditResult <= 0 THEN GO(MRecNo);
              AT(10,25,'ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ');
             END;
      'C' : BEGIN  { Pack }
              FillPage(@MainScreenBuffer);
              ClrScr;
              WriteLn('Removing deleted records...');
              Set_Talk_On;
              Pack;
              MakeIndexes;
              OpenIndexes;
              GoTop;
              DisplayPage(@MainScreenBuffer);
             END;
      'I' : ToggleIndex;
    END; { Case }
  UNTIL choice = 'Q';
  Set_Cursor_On;
end;

procedure log_qso;
begin
  halt_xmt;
  save_screen;
  HAMLOG_MENU;
  restore_screen;
end;

procedure MaintainCallList;
var  MainScreenBuffer : Array[1..2000] OF Word;
begin
  Select(2);
  FillPage(@MainScreenBuffer);
  Set_BrowseWindow_To(1,1,80,15,2,'');
  Browse('');
  DisplayPage(@MainScreenBuffer);
  PKCall := CALLLIST.ROUTING;
end;