program CW_Ident;
{ This program is for a 16F84A-20 to perform a standard CW ident to  }
{ replace the old 10m beacon on 28.264MHz. Existing code no good,    }
{ so a new program has been written by VK6FJA September-2004.        }
{ Uses: 16F84A-20 with Xtal 4.000MHz clock                           }
{ Port A bit 3 is a on-off signal for the ident 1=OFF 0=ON           }
{ Port B bit 0 is the keying output  1= tone 0= no tone              }
{ Port B bit 1 is a PTT output to key the transmitter  1= TxPTT 0=Rx }
{ Compiled using mikroPascal for PIC.                                }

{Global Variables declared here}
const
{character speeds in miliseconds}
long_tone_length  : integer = 10000; {long tone time (for carrier tone)}
long_space_length : word    = 1050;  {Word space time 7 dits}
ch_space_length   : word    = 450;   {inter-character space 1 dah}
space_length      : word    = 150;   {inter-tone space 1 dit}
dit_length        : word    = 150;   {MAIN VARIABLE}
dah_length        : word    = 450;   {3 dits length }

{ Initialise the PIC with default register settings}
Procedure Initialise_Program;
Begin
    PortA:=$00; {Beacon is not switched on by default}
    TRISA:=$FF;  {set port A as input pins (default)}
    TRISB:=$00;  {set port B to output pins}
    PortB:=$00;  {Set all outputs to off - ie key up and PTT off}
End;

{Timing and character generation}
Procedure long_tone;
begin
     SetBit(PortB,0);   {key down}
     Delay_ms(long_tone_length);
     ClearBit(PortB,0);  {key up}
end;
Procedure space;
begin
     ClearBit(PortB,0); {Key up anyway}
     Delay_ms(space_length);
end;
Procedure chspace;
begin
     ClearBit(PortB,0); {Key up anyway}
     Delay_ms(ch_space_length);
end;
Procedure long_space;
begin
     ClearBit(PortB,0); {Key up anyway}
     Delay_ms(long_space_length);
end;
Procedure dit;
begin
     SetBit(PortB,0);   {key down}
     Delay_ms(dit_length);
     ClearBit(PortB,0);   {key up}
     space;
end;
Procedure dah;
begin
     SetBit(PortB,0);   {key down}
     Delay_ms(dah_length);
     ClearBit(PortB,0);   {key up}
     space;
end;


{Morse Code letters and numbers}
Procedure alpha;
begin dit; dah; chspace; end;
Procedure bravo;
begin  dah; dit; dit; dit; chspace; end;
Procedure charlie;
begin dah; dit; dah; dit; chspace; end;
Procedure delta;
begin dah; dit; dit; chspace; end;
Procedure echo;
begin dit; chspace; end;
Procedure foxtrot;
begin dit; dit; dah; dit; chspace; end;
Procedure golf;
begin dah; dah; dit; chspace; end;
Procedure hotel;
begin dit; dit; dit; dit; chspace; end;
Procedure india;
begin dit; dit; chspace; end;
Procedure juliet;
begin dit; dah; dah; dah; chspace; end;
Procedure kilo;
begin dah; dit; dah; chspace; end;
Procedure lima;
begin dit; dah; dit; dit; chspace; end;
Procedure mike;
begin dah; dah; chspace; end;
Procedure november;
begin dah; dit; chspace; end;
Procedure oscar;
begin dah; dah; dah; chspace; end;
Procedure papa;
begin dit; dah; dah; dit; chspace; end;
Procedure quebec;
begin dah; dah; dit; dah; chspace; end;
Procedure romeo;
begin dit; dah; dit; chspace; end;
Procedure sierra;
begin dit; dit; dit; chspace; end;
Procedure tango;
begin dah; chspace; end;
Procedure uniform;
begin dit; dit; dah; chspace; end;
Procedure victor;
begin dit; dit; dit; dah; chspace; end;
Procedure whiskey;
begin dit; dah; dah; chspace; end;
Procedure xray;
begin dah; dit; dit; dah; chspace; end;
Procedure yankee;
begin dah; dit; dah; dah; chspace; end;
Procedure zulu;
begin dah; dah; dit; dit; chspace; end;
Procedure zero;
begin dah; dah; dah; dah; dah; chspace; end;
Procedure one;
begin dit; dah; dah; dah; dah; chspace; end;
Procedure two;
begin dit; dit; dah; dah; dah; chspace; end;
Procedure three;
begin dit; dit; dit; dah; dah; chspace; end;
Procedure four;
begin dit; dit; dit; dit; dah; chspace; end;
Procedure five;
begin dit; dit; dit; dit; dit; chspace; end;
Procedure six;
begin dah; dit; dit; dit; dit; chspace; end;
Procedure seven;
begin dah; dah; dit; dit; dit; chspace; end;
Procedure eight;
begin dah; dah; dah; dit; dit; chspace; end;
Procedure nine;
begin dah; dah; dah; dah; dit; chspace; end;



{ This procedure is to actually send out the CW-ID  }
Procedure Do_CW_ID;
Begin
    SetBit(PortB,1); {Turn PTT on}
    long_tone;
    long_space;
    victor; kilo; six; romeo; whiskey; alpha;
    long_space;
    long_tone;
    long_space;
    papa; echo; romeo; tango; hotel;
    long_space;
    ClearBit(PortB,1); {Turn PTT off}
End;



{ Mainline Program loop }
Begin
     Initialise_Program;
     Repeat
       Begin
          { Send out CW id if the beacon is switched 'on' ie. PA3 = 0}
          If TestBit(PORTA,3) = 0 then Do_CW_ID
              else ClearBit(PortB,1); {otherwise just turn the PTT off}
       end;
     Until 0 =1;  {Repeat the program indefinitely}
End.