{$N+}
Program r7;
{Talks to R7000 receiver

REMEMBER TO SET MODE FOR COM1 TO 1200,N,8,1 BEFORE RUNNING!!}
{Pins 6-20 and 4-5 were jumpered together before mod for the tape
recorder.  I removed the jumpers and it appeared to work OK}

uses
    DOS, lctkrnl, lctsupp, crt;

const
    baud     : integer = 1200;
    parity   : char = 'N';
    databits : integer = 8;
    stopbits : integer = 1;
    insize   : integer = 256;
    outsize  : integer = 256;


type
    string80 = string [80];
    mode_type = (AM, FM, FMN, SSB);

var
     char_table : string80;
     out_port, in_port : text;
     cstat : byte;
     debug, talk : boolean;

{----------------------------------------------------------------------------}
procedure wait (counter : integer);
var
     counter2 : integer;
begin
     for counter2 := 1 to counter do;
end;

{----------------------------------------------------------------------------}
function make_deci (hexvalue : integer) : integer;
var tens, ones, make_real : real;

begin
     tens := int (hexvalue);
     tens := trunc (tens  / 10);
     ones := int (hexvalue) - (tens * 10);
     make_real := (tens * 16) + ones;
     make_deci := round (make_real);
     if debug then writeln ('Hexvalue = ', hexvalue, ' Tens = ', tens,
           ' Ones = ', ones, ' Result = ', make_real);



end;

{----------------------------------------------------------------------------}
function make_hex (decivalue : integer) : integer;
var tens, ones, make_real : real;

begin
     tens := int (decivalue);
     tens := trunc (tens  / 16);
     ones := int (decivalue) - (tens * 16);
     make_real := (tens * 10) + ones;
     make_hex := round (make_real);
     if debug then writeln ('Hexvalue = ', decivalue, ' Tens = ', tens,
           ' Ones = ', ones, ' Result = ', make_real);



end;

{----------------------------------------------------------------------------}
procedure write_port (control_no : integer; data_code : string80);

{CONTROL CODES

3  = read frequency
4  = read mode
5  = set frequency
6  = set mode
8  = set memory channel
9  = memory write
11 = memory clear

MODES
2 = AM
5 + 2 = FMn
5 = FM
5 + 0 = SSB

}

var
     output_line : string80;
     preamble    :string [2];
     rx_addr, tx_addr, control_code, eom : string [1];
     chars_sent : integer;
begin

     preamble := chr (254)+chr(254);
     rx_addr := chr (8);
     tx_addr := chr (2);
     eom     := chr (253);
     control_code := chr (control_no);

     output_line := preamble+rx_addr+tx_addr+control_code+data_code+eom;

     chars_sent :=  putstream (1, output_line [1], length (output_line));
     if debug then writeln (' Put ', chars_sent);
     delay (200);

     if talk then writeln ('Output line = ',chars_sent, ' bytes');
end;
{----------------------------------------------------------------------------}
procedure write_null (control_no : integer);

var
     output_line : string80;
     preamble    :string [2];
     rx_addr, tx_addr, control_code, eom : string [1];
     chars_sent : integer;
begin

     preamble := chr (254)+chr(254);
     rx_addr := chr (8);
     tx_addr := chr (2);
     eom     := chr (253);
     control_code := chr (control_no);
     output_line := preamble+rx_addr+tx_addr+control_code+eom;
     chars_sent :=  putstream (1, output_line [1], length (output_line));
     if talk then writeln ('Output line = ',chars_sent, ' bytes');
end;
{----------------------------------------------------------------------------}
procedure set_mode (newmode : mode_type);

var
   out_char : string [2];

begin

     case newmode of
          fm :  write_port (6,chr (5));
          am :  write_port (6,chr (2));
          fmn :
               begin
                    out_char := chr (5) + chr (2);
                    write_port (6,out_char);
               end;
          ssb :
               begin
                    out_char := chr (5) + chr (0);
                    write_port (6,out_char);
               end;
     end; {case}

end;

{----------------------------------------------------------------------------}
procedure set_channel (mem_channel : integer);

begin
     writeln ('Setting memory channel ', mem_channel);
     write_port (8, chr (mem_channel));
end;

{----------------------------------------------------------------------------}
procedure set_freq (freq : real);
var
   out_string : string [80];
   b, b1, b2 : real;
   n,hexn : integer;
begin
     if talk then writeln ('Setting freq to ', freq : 6 : 3);
     debug := false;
     b := freq;
     out_string := '';
     b1 := b * 1000 * 1000; {Translate to Hz from MHz}
     b2 := 9999;  {Initialize B2 to dummy value to start the loop}
     while (b2 > 0) do
     begin
          b2 := int ((b1 / 100) + 0.0001);
          n := trunc (b1 - (b2 * 100.0)); {Parse out lower 100 field}
          if debug then writeln ('B1 = ', b1, ' B2= ', b2, ' N= ', n,
               ' CHR(N) = ', chr (n));
          hexn := make_deci (n);
          out_string := out_string + chr (hexn);
          b1 := b2;
     end;
     if debug then writeln ('out string = ', (out_string));
     write_port (5,out_string);
end;

{----------------------------------------------------------------------------}
procedure read_freq (var freq : extended);
var
   hex_value_real, temp_freq : extended;
   in_char, nothing : char;
   good_read, freq_read : boolean;
   in_byte : byte;
   in_line, string_freq, string_value : string [10];
   return_code, counter, counter1, chars_read, bytes_to_read,
           hex_value, field_counter, data_char, wait_counter : integer;

begin
     in_line := 'Nothing changed';
     string_freq := '';
     counter := 1;
     field_counter := 0;
     temp_freq := 0;
     freq := 0;

     write_null (3);
     if not purgerxbuff (1) then writeln ('Buffer not able to be purged');
     delay (300);
     bytes_to_read := bytesininput (1);
     wait_counter := 0;

     while bytes_to_read = 0 do
     begin
          wait_counter := succ (wait_counter);
          if wait_counter = 1000 then
          begin
               writeln ('Timeout waiting for input from R-7000');
               halt (1);
          end;
          bytes_to_read := bytesininput (1);
     end;

     if talk then writeln ('Bytes in input = ', bytes_to_read);
     for counter1 := 1 to bytes_to_read do
     begin
          field_counter := field_counter + 1;
          good_read := lctget (1, in_byte);
          if not (good_read) then writeln ('Bad read');

          case in_byte of
               254 :
               begin
                    if talk then writeln ('Header');
                    field_counter := 2;
                    temp_freq := 0;
                    freq_read := false;
               end;
               253 :
               begin
                    if talk then
                    begin
                         writeln ('EOM');
                         nothing := readkey;
                    end;
               end;
          else
               hex_value := make_hex (in_byte);
               hex_value_real := hex_value;
               data_char := field_counter - 5;
               if talk then writeln ('Counter = ', field_counter, ' Data char = ',
                       data_char, ' Field Char is ',
                       in_byte, ' hex =  ', hex_value);
               case data_char of
                    1: temp_freq := temp_freq + (hex_value_real);
                    2: temp_freq := temp_freq + (hex_value_real * 100);
                    3: temp_freq := temp_freq + (hex_value_real * 10000);
                    4: temp_freq := temp_freq + (hex_value_real * 1000000);
                    5:
                    begin
                         temp_freq := temp_freq + (hex_value_real * 100000000);
                         if talk then writeln ('Freq = ', temp_freq/1000000 : 3 : 4);
                    end;
              end;  {case data}
          end;  {case in_byte}
          freq := temp_freq;
     end; {for counter = 1}






end;

{----------------------------------------------------------------------------}
{main procedure}
var
     fcounter, counter1 : integer;
     dsrstat : byte;
     start_freq, end_freq, freq_inc, frequency : extended;
     bool : boolean;

begin

     debug := false;
     talk := false;

     if (commopen (1, baud, parity, databits, stopbits, insize, outsize))
        then writeln ('Com1 opened')
        else writeln ('Error opening Com1');
     if not clearmodemsignals (1, (dtr and rts)) then
        writeln ('Unable to set DTR and RTS');
{
     set_mode (ssb);
     delay (300);
     set_mode (fmn);
     delay (300);
}


{     set_channel (6);
}
{

     for counter1 := 1 to 50 do
     begin

          read_freq (frequency);
          writeln ('Downlink freq is ', frequency/1000000 : 4 : 3,
                  ' Uplink freq is ', (146.0  - (frequency - 435)): 4 : 3);
     end;
}

{
     for fcounter := 145 to 220 do
     begin
          frequency := fcounter;
          set_freq (frequency);
     end;
}

{    for fcounter := 1 to 30 do
     begin
         set_channel (fcounter);
         wait (20000);
         wait (20000);
     end;
}
{
    set_freq (221.01);

     for counter1 := 1 to 5000 do
     begin
          delay (500);
          set_freq (221.01);
          cstat := modemstatus (1);
          dtrstat := (cstat and dtr);
          writeln ('Modem status = ',cstat, '; DTR status = ', dtrstat);
          if (dtrstat <> 0) then writeln ('DCD active')
          else writeln ('DCD not active');
     end;

}


     start_freq := 146.52;
     end_freq := 147.445;
     freq_inc := 0.015;
     frequency := start_freq;
     bool :=  setmodemsignals (1, rts);
     cstat := modemstatus (1);

     while frequency <= end_freq do
     begin
          set_freq (frequency);
          delay (50);
          cstat := modemstatus (1);
          dsrstat := (cstat and dsr);
          if (dsrstat <> 0) then
               writeln ('Freq ', frequency : 3 : 3, 'is BUSY')
          else
               writeln ('Freq ', frequency : 3 : 3, ' is not busy');
          frequency := frequency + freq_inc;
     end;





     commclose (1);
     writeln ('COM1 closed');
end.