program offsetlist;
uses crt,v24;

const
    modes:array[0..4] of string[4]=(' FM ',' AM ','LSB ','USB ',' CW ');
    norms:string='eruiaqf';
    tonshift:array[0..6] of longint=(5500000,6500000,6000000,5500000,4500000,5500000,6500000);
    rus:array[1..5] of longint=(49750000,59250000,77250000,85250000,93250000);
    fra:array[2..4] of longint=(55750000,60500000,63750000);
    ita:array[2..9] of longint=(53750000,62250000,82250000,175250000,183250000,192250000,201250000,210250000);
    syst:array[0..6] of string=('Europe B/G','Russia/East Europe','UK & Ireland',
    'Italy','America','Cable Europe','France L/K');
    bws:array[0..6] of string=('500','3k','6k','15k','30k','110k','220k');
var ton,arit:boolean;
    cs:string[3];
    tkt:word;
    rit,ofs,qrg1,qrg2,x:longint;
    bw,k,mode,norm,tc1,tc2:byte;
    s:string;
    t:char;

procedure wport(pt:integer;i,d:byte);
var k:byte;
  begin
     port[pt]:=I;
     for k:=0 to 200 do;
     port[pt+1]:=D;
     for k:=0 to 200 do;
  end;

function portaddress(c:byte):word;
begin;
if c=1 then portaddress:=$3f8;
if c=2 then portaddress:=$2f8;
if c=3 then portaddress:=$3e8;
if c=4 then portaddress:=$2e8;
end;

procedure setbaudrate(com:byte;b:longint);
var x,y:byte;
    z:longint;
begin;
x:=port[portaddress(com)+3];
y:=x;
if y<$80 then x:=y+$80;
port[portaddress(com)+3]:=y;
z:=115200 div b;
wport(portaddress(com),z mod 256,z div 256);
port[portaddress(com)+3]:=x;
writeln(z mod 256,z div 256);
end;

procedure wcom(com:byte;s:string);
var x:byte;
    y:word;
begin;
for x:=1 to length(s) do
begin;
v24write(s[x]);
delay(tkt div 4);
end;
v24write(chr(13));
delay(tkt*4);
end;

procedure iniport;
begin;
port[$3fb]:=$80;
delay(200);
port[$3f8]:=6;  (*baud*);
delay(200);
port[$3f9]:=0;
delay(200);
port[$3fa]:=3;   (*FIFO on*)
port[$3fb]:=7;   (*full bytes 2 stop bits, $3f8 control mode off*)
port[$3f9]:=3;   (*read/write enable*)
port[$3f8]:=13;
delay(300);
end;

procedure autorit;
  begin;
  if arit then
    begin;
    if (qrg1>400000000) then rit:=((qrg1-471250000) div 320000)+300;
    if (qrg1>150000000) and (qrg1<400000000) then rit:=((qrg1-175250000) div 400000)-250;
    if (qrg1<150000000) then rit:=0;
    end;
  end;

function qrg:longint;
var y:longint;
begin;
if (norm=0) or (norm=3) then
   begin;
   if (k>=2) and (k<=4) then y:=48250000+(k-2)*7000000+1302*ofs;
   if (k>=5) and (k<=12) then y:=175250000+(k-5)*7000000+1302*ofs;
   end;
if norm=1 then
   begin;
   if k<6 then y:=rus[k]+1302*ofs;
   if (k>=6) and (k<13) then y:=175250000+(k-6)*8000000+1302*ofs;
   end;
if (norm=2) then
   begin;
   if (k>2) and (k<5) then y:=45750000+(k-2)*8000000+1302*ofs;
   if (k>4) and (k<10) then y:=175250000+(k-5)*8000000+1302*ofs;
   if (k>9) and (k<21) then k:=21;
   end;
if norm=3 then
   begin;
   if k<10 then y:=ita[k]+1302*ofs;
   end;
if norm=4 then
   begin;
   if k<5 then y:=55250000+(k-2)*6000000+1094*ofs;
   if (k=5) or (k=6) then y:=77250000+(k-5)*6000000+1094*ofs;
   if (k>6) and (k<14) then y:=175250000+(k-7)*6000000+1094*ofs;
   if (k>13) then y:=471250000+(k-14)*6000000+1094*ofs;
   end;
if norm=5 then
   begin;
   if k<=10 then y:=105250000+(k-1)*7000000+1302*ofs;
   if k>=11 then y:=175250000+(k-3)*7000000+1302*ofs;
   end;
if norm=6 then
   begin;
   if k<5 then y:=fra[k]+1302*ofs;
   if (k<13) and (k>4) then y:=176000000+(k-6)*8000000+1719*ofs;
   end;
if ((norm>=0) and (norm<=4)) or (norm=6) then if (k>=21) then y:=471250000+(k-21)*8000000+1302*ofs;
if ton then y:=y+tonshift[norm];
if (norm=6) and (k<5) and ton then y:=y-13000000;
qrg:=y;
end;

procedure modeline;
var x:byte;
begin;
for x:=0 to 4 do
  begin;
  gotoxy (x*6+3,4);
  if x=mode then begin;textcolor(15);textbackground(8);end
     else textcolor(0);textbackground(6);
  write(modes[x]);
  end;
for x:=0 to 6 do
  begin;
  gotoxy(x*3+3,8);
  if x=norm then begin;textcolor(15);textbackground(8);end
     else textcolor(0);textbackground(6);
  write(norms[x+1]);
  end;
for x:=0 to 6 do
  begin;
  gotoxy(x*6+3,6);
  if x=bw then begin;textcolor(15);textbackground(8);end
     else textcolor(0);textbackground(6);
  write(bws[x]);
  end;
end;

procedure nm;
begin;
textcolor(15);textbackground(0);
end;

procedure inv;
begin;
textcolor(0);textbackground(15);
end;

procedure channelline;
begin;
gotoxy(2,10);
nm;
write('Channel : ');
inv;
str(k,cs);
if ((norm=3) or (norm=2)) and (k<13) then cs:=chr(63+k);
write(cs);
nm;
write('      Offset: ');
inv;
write(ofs:3);
gotoxy(2,13);
nm;
write('Frequency : ');
inv;
write(qrg1:10);
nm;
gotoxy(2,16);
write('RIT finetune: ');
inv;
write(rit:10);
nm;
if ton then
  begin;
  gotoxy(2,18);
  inv;
  write('Sound Frequency');
  nm;
  end;
end;

procedure tktset;
begin;
gotoxy(1,25);
write('Processor rate MHz:');
read(tkt);
end;

procedure screen1;
begin;
textbackground(0);
clrscr;
textbackground(15);textcolor(0);
write('AOR 5000 Offset Remote 1.03');
textbackground(0);textcolor(15);
write(' by DL2LBP Peer-Axel Kroeske 5.9.2001');
gotoxy(60,4);
write('F1...F9');
gotoxy(60,6);
write('Bandwith 0..6');
gotoxy(60,8);
write('System (letter)');
gotoxy(35,8);
inv;
write(syst[norm]);
nm;
gotoxy(40,10);
write('c:          set channel');
gotoxy(40,11);
write('left/right: channel +/-');
gotoxy(40,12);
write('up/down:    offset +/-');
gotoxy(40,13);
write('PgUp/PgDn:  offset +8/-8');
gotoxy(40,14);
write('Pos1:       offset 0');
gotoxy(40,16);
write('+/- RIT finetune');
gotoxy(2,17);
if arit then write('AutoRIT');
gotoxy(40,17);
write('# AutoRIT on/off');
gotoxy(40,18);
write('s: switch video/audio');
gotoxy(2,21);
write('Processor:',tkt, 'MHz');
gotoxy(40,21);
write('t: change processor');
gotoxy(40,22);
write('ESC to quit');
modeline;
channelline;
end;


procedure bwset;
begin;
str(bw,s);
wcom(1,'BW'+s);
end;

procedure modeset;
begin;
str(mode,s);
wcom(1,'MD'+s);
end;

procedure chchk;
begin;
if (norm=0) or (norm=1) then
  begin;
  if (k>12) and (k<20) then k:=21;
  if k=20 then k:=12;
  if k<1 then k:=69;
  if k>75 then k:=2;
  if (k=1) and (norm=0) then k:=69;
  end;
if (norm=2) or (norm=3) then
  begin;
  if (k>9) and (k<20) then k:=21;
  if k=20 then k:=9;
  if k<2 then k:=69;
  if k>75 then k:=2;
  end;
if norm=4 then
  begin;
  if k<2 then k:=69;
  if k>75 then k:=2;
  end;
if norm=5 then
  begin;
  if k<2 then k:=45;
  if k>41 then k:=2;
  end;
if norm=6 then
  begin;
  if (k>10) and (k<20) then k:=21;
  if k=20 then k:=10;
  if k<2 then k:=69;
  if k>69 then k:=2;
  end;
end;

procedure setfreq;
  begin;
  str(qrg1+rit,s);wcom(1,'RF'+s);
  end;

procedure tonset;
begin;
    ton:=not ton;
    if ton then
      begin;
      if (norm<6) then begin;mode:=0;bw:=4;end
        else begin;mode:=1;bw:=3;end;
      end else
        begin;
        mode:=3;
        bw:=0;
        end;
    qrg1:=0;
end;

begin;
v24open(1,19200,8,'K',2,'K');
clrscr;
k:=2;
ton:=false;
mode:=3;
ofs:=0;
rit:=-800;
tkt:=400;
qrg1:=48250000;
screen1;
norm:=0;
arit:=false;
setfreq;
modeset;

repeat
screen1;
t:=readkey;
tc1:=ord(t);tc2:=0;
if tc1=0 then
  begin;
  tc2:=ord(readkey);
  if tc2=72 then inc(ofs);
  if tc2=80 then dec(ofs);
  if tc2=71 then ofs:=0;
  if tc2=73 then ofs:=ofs+8;
  if tc2=81 then ofs:=ofs-8;
  if tc2=75 then begin;dec(k);chchk;end;
  if tc2=77 then begin;inc(k);chchk;end;
  if (tc2>=59) and (tc2<=63) then begin;mode:=tc2-59;modeset;end;  (*Mode*)
  end else
  begin;
  for x:=0 to 6 do if norms[x+1]=t then begin;
    norm:=x;
    tonset;
    end;
  if t='s' then tonset;
  if t='+' then begin;rit:=rit+10;setfreq;end;
  if t='-' then begin;rit:=rit-10;setfreq;end;
  if t='#' then begin;arit:=not arit;autorit;setfreq;end;
  if t='t' then tktset;
  if (tc1>48) and (tc1<56) then
    begin;
    bw:=tc1-49;
    str(bw,s);
    wcom(1,'BW'+s);
    modeline;
    end;
  if t='c' then
    begin;
    gotoxy(11,10);
    inv;
    write('   ');
    gotoxy(11,10);
    read(k);
    nm;
    end;
  if t='o' then
    begin;
    gotoxy(28,10);
    inv;
    write('   ');
    gotoxy(28,10);
    read(k);
    nm;
    end;
  end;
  qrg2:=qrg;
  if qrg2<>qrg1 then
    begin;
    qrg1:=qrg2;
    if arit then autorit;
    setfreq;
    modeset;
    bwset;
    end;
until tc1=27;
end.