{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
With "Bismillahi-r-Rahmani-r-Rahim", I release:

KLI Data Shaper Decoder 1.01 - August 30, 2002
(C) by Arman Yusuf, S.Kom - YB0KLI
http://www.qsl.net/yb0kli
arman@mik.co.id

"Too Freeware" - This is your free lunch:
Please retain all intellectual properties for your modified source-code,
keep people smile, because we made it with smile.

The ones who inspire me:
Portion of basic software (C) by Pawel Jalocha, SP9VRC of PKTMON
Portion of basic hardware (C) by W. F. Schroeder, DL5YEC of HAMComm
ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}

Program KLIDataShaperDecoder;
Uses    Dos, Crt;

{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ® Interrupt Buffers ¯ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Const   BufferSize = $3FFF;
Type    Buffer =  Record
        ReadPtr:  Word;
        WritePtr: Word;
        Store:    Array [0 .. BufferSize] Of Word
End;Var PeriodBuffer: Buffer;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}

Const   ModemFIFOLen =       31;
        FilterFIFOLen =      63;
        TimerFreq:           LongInt = 1193180;
        TimerBase =          $40;
        MaxFrameLen =        1024;
Var
        {Modem FIFO Settings}
        ModemFIFO:           Array [0 .. ModemFIFOLen] Of Word;
        ModemFIFORdPtr:      Word;
        ModemFIFOWrPtr:      Word;
        ModemFIFOTrans:      Word;

        {FIFO Filter Settings}
        FilterPerFIFO:       Array [0 .. FilterFIFOLen] Of Word;
        FilterLevFIFO:       Array [0 .. FilterFIFOLen] Of Boolean;
        FilterFIFORdPtr:     Word;
        FilterFIfOWrPtr:     Word;
        FilterSum:           Word;
        FilterSampling:      Word;
        FilterSamplingPhase: Word;
        FilterTimeLen:       Word;
        CorrThreshold:       Word;
        Sample_1, Sample_2:  Integer;
        Level_1, Level_2:    Boolean;
        SampleBitNow:        Boolean;
        SyncStep:            Word;
        SampleAver:          Integer;
        InterSampleAver:     Integer;

        {Interrupt Settings}
        OldIntVec:           Pointer;
        PrevTime:            Word;
        LostSamples:         Word;

        {Modem Settings}
        CommBase:             Word;
        IntMask, IntNum:      Byte;

        {Decoder Settings}
        Reg:                  Word;
        ByteSync:             Byte;
        PrevBit:              Boolean;

        {Frame Settings}
        FrameBuff:            Array [0 .. MaxFrameLen - 1] Of Byte;
        FramePtr, BitCount:   Word;
        ByteReg, ConsBits:    Word;
        BadFrame:             Boolean;
        FrameCount:           LongInt;

        {Result Settings}
        Callsign, FrameCtl:  String;
        DataFrame:           String;
        CheckCRC, ItIsError: Boolean;
        RedirectSound:       Boolean;

{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ® Interrupt Library ¯ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
Functions:
   None:-

Procedures:
   DisableInterrupts()
   EnableInterrupts()
   InitBuffer(Var Buff: Buffer)
   ReadTimer(Var Time: Word)
   ReadBuffer(Var Buff: Buffer; Var Written: Word; Var Empty: Boolean)
   WriteBuffer(Var Buff: Buffer; Var Written: Word; Var Full: Boolean)
   Procedure DeltaInterrupt(FL,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP: Word)
   InitTimer()
   ConnectInterrupt()
   DisconnectInterrupt()
ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}

Procedure DisableInterrupts; InLine($FA);
Procedure EnableInterrupts;  InLine($FB);

Procedure InitBuffer(Var Buff: Buffer);
Begin
     Buff.ReadPtr  := 0;
     Buff.WritePtr := 0
End;

{$S-}{$R-}
Procedure ReadTimer(Var Time: Word); Assembler;
Asm
     XOR  AL, AL
     OUT  TimerBase + 3,AL
     IN   AL, TimerBase
     XCHG AL, AH
     IN   AL, TimerBase
     XCHG AL, AH
     LES  DI, Time
     MOV  ES:[DI], AX
End;

Procedure ReadBuffer(Var Buff: Buffer; Var Written: Word;
                     Var Empty: Boolean); Assembler;
Asm
     PUSH DS
     LES  DI, Empty
     MOV  DL, 0FFH
     MOV  ES:[DI], DL
     LDS  SI, Buff
     MOV  AX, [SI]
     MOV  BX, SI
     MOV  CX, [SI + 2]
     CMP  AX, CX
     JZ   @EMPT

     MOV  DL, 0
     MOV  ES:[DI], DL
     LES  DI, Written
     ADD  SI, 4
     ADD  SI, AX
     ADD  SI, AX
     MOV  DX, [SI]
     MOV  ES:[DI], DX
     ADD  AX, 1
     AND  AX, BufferSize
     MOV  DS:[BX], AX

     @EMPT:
     POP  DS
End;

Procedure WriteBuffer(Var Buff: Buffer; Written: Word;
                      Var Full: Boolean); Assembler;
Asm
     PUSH DS
     LES  DI, Full
     MOV  DL, 0FFH
     MOV  ES:[DI], DL
     LDS  SI, Buff
     MOV  AX, [SI]
     ADD  SI, 2
     MOV  CX, [SI]
     MOV  BX, SI
     ADD  SI, 2
     ADD  SI, CX
     ADD  SI, CX
     ADD  CX, 1
     AND  CX, BufferSize
     CMP  AX, CX
     JZ   @Ful

     MOV  DL, 0
     MOV  ES:[DI], DL
     MOV  DX, Written
     MOV  [SI], DX
     MOV  [BX], CX

     @Ful:
     POP  DS
End;

Procedure DeltaInterrupt(FL, CS, IP,
                         AX, BX, CX, DX,
                         SI, DI, DS, ES, BP: Word); Interrupt;
Var  Time: Word;
     Full: Boolean;
     Test: Boolean;
Begin
     Port[$20] := $20;
     If (Port[CommBase + 2] And 7) = 0 Then Begin
          If (Port[CommBase + 6] And 2) <> 0 Then ReadTimer(Time);
	  WriteBuffer(PeriodBuffer, (PrevTime - Time) Shr 1, Full);
	  If Full Then Inc(LostSamples);
	  PrevTime := Time;
          If RedirectSound Then Begin
               Sound(1200);
               NoSound;
          End;
     End;
End;
{$S+}{$R+}

Procedure InitTimer;
Begin
     DisableInterrupts;
     Port[TimerBase + 3] := $36;
     Port[TimerBase] := 0;
     Port[TimerBase] := 0;
     EnableInterrupts
End;

Procedure ConnectInterrupt;
Begin
     ReadTimer(PrevTime);
     LostSamples := 0;
     DisableInterrupts;

     GetIntVec(IntNum, OldIntVec);
     SetIntVec(IntNum, Addr(DeltaInterrupt));

     Port[$21]          := Port[$21] And (Not IntMask);
     Port[CommBase + 1] := $08;
     EnableInterrupts
End;

Procedure DisconnectInterrupt;
Begin
     DisableInterrupts;
     Port[CommBase + 1] := $00;
     Port[$21] := Port[$21] Or IntMask;
     SetIntVec(IntNum, OldIntVec);
     EnableInterrupts
End;

{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ® Error Checking ¯ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
Functions:
   ComputeCRC() : Word
   GetCRC() : Word

Procedures:
   None:-
ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Const CRCTable: Array[0 .. 255] Of Word = (
	    0,  4489,  8978, 12955, 17956, 22445, 25910, 29887,
	35912, 40385, 44890, 48851, 51820, 56293, 59774, 63735,
	 4225,   264, 13203,  8730, 22181, 18220, 30135, 25662,
	40137, 36160, 49115, 44626, 56045, 52068, 63999, 59510,
	 8450, 12427,   528,  5017, 26406, 30383, 17460, 21949,
	44362, 48323, 36440, 40913, 60270, 64231, 51324, 55797,
	12675,  8202,  4753,   792, 30631, 26158, 21685, 17724,
	48587, 44098, 40665, 36688, 64495, 60006, 55549, 51572,
	16900, 21389, 24854, 28831,  1056,  5545, 10034, 14011,
	52812, 57285, 60766, 64727, 34920, 39393, 43898, 47859,
	21125, 17164, 29079, 24606,  5281,  1320, 14259,  9786,
	57037, 53060, 64991, 60502, 39145, 35168, 48123, 43634,
	25350, 29327, 16404, 20893,  9506, 13483,  1584,  6073,
	61262, 65223, 52316, 56789, 43370, 47331, 35448, 39921,
	29575, 25102, 20629, 16668, 13731,  9258,  5809,  1848,
	65487, 60998, 56541, 52564, 47595, 43106, 39673, 35696,
	33800, 38273, 42778, 46739, 49708, 54181, 57662, 61623,
	 2112,  6601, 11090, 15067, 20068, 24557, 28022, 31999,
	38025, 34048, 47003, 42514, 53933, 49956, 61887, 57398,
	 6337,  2376, 15315, 10842, 24293, 20332, 32247, 27774,
	42250, 46211, 34328, 38801, 58158, 62119, 49212, 53685,
	10562, 14539,  2640,  7129, 28518, 32495, 19572, 24061,
	46475, 41986, 38553, 34576, 62383, 57894, 53437, 49460,
	14787, 10314,  6865,  2904, 32743, 28270, 23797, 19836,
	50700, 55173, 58654, 62615, 32808, 37281, 41786, 45747,
	19012, 23501, 26966, 30943,  3168,  7657, 12146, 16123,
	54925, 50948, 62879, 58390, 37033, 33056, 46011, 41522,
	23237, 19276, 31191, 26718,  7393,  3432, 16371, 11898,
	59150, 63111, 50204, 54677, 41258, 45219, 33336, 37809,
	27462, 31439, 18516, 23005, 11618, 15595,  3696,  8185,
	63375, 58886, 54429, 50452, 45483, 40994, 37561, 33584,
	31687, 27214, 22741, 18780, 15843, 11370,  7921,  3960);

{$R-}{$S-}
Function ComputeCRC: Word;
Var PChk, CRC, Test: Word;
Begin
     CRC := $FFFF;
     For PChk  := 0 to FramePtr - 1 - 2 Do Begin
          Test := FrameBuff[PChk] Xor (CRC And $FF);
          CRC  := Hi(CRC) Xor CRCTable[Test]
     End;
     ComputeCRC := Not CRC;
End;

Function GetCRC: Word;
Begin
     GetCRC := FrameBuff[FramePtr - 2] Or (FrameBuff[FramePtr - 1] Shl 8)
End;

{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ® Text Matters ¯ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
Functions:
   HexDigit(B: Byte) : Char
   Hex(B: Byte) : String
   toStr(I: Byte) : String
   Time() : String

Procedures:
   Beep()
   CursorOn()
   CursorOff()
ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}

Function HexDigit(B: Byte): Char;
Begin
     If B < 10 Then HexDigit := Chr(48 + B)
     Else If B < 16 Then HexDigit := Chr(65 - 10 + B)
     Else HexDigit := '0'
End;

Function Hex(B: Byte) : String;
Begin
    Hex := HexDigit(B Shr 4) + HexDigit(B and $F)
End;

Function toStr(I: Byte) : String;
Var Buff: String;
Begin
     Str(I, Buff);
     toStr := Buff
End;

Procedure Beep;
Var Prt: Byte;
Begin If Not RedirectSound Then
     If ItIsError Then
     Begin
          Sound(1000);
          Delay(40);
          NoSound;
     End Else
     For Prt := 1 To 4 Do Begin
          Sound(500 * Prt);
          Delay(10);
          NoSound;
     End;
End;

Procedure CursorOn;
Var  VideoMode: Byte Absolute $0040:$0049;
     Reg:       Registers;
Begin
     If VideoMode = 7 Then
          Reg.CX := $0C0D
     Else
          Reg.CX := $0607;
          Reg.AX := $0100;
          Intr($10, Reg);
End;

Procedure CursorOff;
Var Reg: Registers;
Begin
     Reg.AX := $0100;
     Reg.CX := $2020;
     Intr($10, Reg);
End;

Function Time : String;
Var Hour, Minute, Second, HSec: Word;
     Function LeadingZero(Text: Word) : String;
     Var StrTxt: String;
     Begin
     Str(Text:0, StrTxt);
     If Length(StrTxt) = 1 then StrTxt := '0' + StrTxt;
     LeadingZero := StrTxt;
     End;
Begin
     GetTime(Hour, Minute, Second, HSec);
     Time := LeadingZero(Hour) + ':' + LeadingZero(Minute) + ':' + LeadingZero(Second)
End;

{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ® Processing Units ¯ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
Functions:
   None:-

Procedures:
   AddBitToFrame(Bit: Boolean)
   CloseFrame()
   OpenFrame()
   AnalyzeBit(Bit: Boolean)
   FilterNextSample(Signal: Word)
   FilterInput(Level: Boolean, Len: Word)
   FilterPreInput(Level: Boolean, Len: Word)
   ModemDelayInput(Period: Word)
ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}

Procedure AddBitToFrame(Bit: Boolean);
     Procedure AddBit(B: Word); Begin
          ByteReg := (ByteReg Shr 1) Or B;
          Inc(BitCount);
          If ((BitCount And 7) = 0) Then If FramePtr < MaxFrameLen Then Begin
               FrameBuff[FramePtr] := Lo(ByteReg);
               Inc(FramePtr)
          End Else BadFrame := True
     End;

Begin
     If Not BadFrame Then Begin
          If Bit Then AddBit($80) Else If ConsBits < 5 Then AddBit($00);
          If Bit Then Inc(ConsBits) Else ConsBits := 0;
          If ConsBits > 5 Then BadFrame := True
     End;
End;

Procedure ProcessFrame; Forward;
Procedure CloseFrame;
Begin
     If FramePtr >= 17 Then Inc(FrameCount) Else BadFrame := True;
     If (BitCount And $7) <> 0 Then BadFrame := True;
     If Not BadFrame Then Begin
          ItIsError := ComputeCRC <> GetCRC;
          If (NOT ItIsError) Or (ItIsError And Not CheckCRC) Then ProcessFrame;
     End;
End;

Procedure OpenFrame;
Begin
     FramePtr := 0;
     BitCount := 0;
     ByteReg  := 0;
     ConsBits := 0;
     BadFrame := False
End;

Procedure AnalyzeBit(Bit: Boolean);
Begin
     If Bit Xor PrevBit Then Reg := (Reg Shl 1) Else Reg := (Reg Shl 1) Or 1;
     PrevBit := Bit;
     If ByteSync > 0 Then Dec(ByteSync) Else AddBitToframe((Reg And $100) <> 0 );
     If Lo(Reg) = $7E Then Begin
          CloseFrame;
          OpenFrame;
          ByteSync := 8
     End
End;

Procedure FilterNextSample(Signal: Word);
Const
     SyncConst  = 8;
     SyncConst2 = 4;
Var  Sample:      Integer;
     Level:       Boolean;
     Diff, Lim:   Integer;
Begin
     Sample := Signal - CorrThreshold;
     Level := Sample > 0;
     If SampleBitNow Then Begin
          SampleAver := SampleAver + (10 * Abs(Sample_1) - SampleAver + 16) Div 32;
          AnalyzeBit(Level_1);
     End Else Begin
          If Level_2 Xor Level Then Begin
               Diff := Sample_1;
               If Level Then Diff := -Diff;
               InterSampleAver := InterSampleAver + (10 * Sample_1 - InterSampleAver + 16) Div 32;
	       If Diff >= SyncConst Then FilterSamplingPhase := FilterSamplingPhase + ((Diff) Div SyncConst2)
               Else If Diff <= -SyncConst Then FilterSamplingPhase := FilterSamplingPhase - ((-Diff) Div SyncConst2)
               Else If Diff > 0 Then Inc(FilterSamplingPhase)
               Else If Diff < 0 Then Dec(FilterSamplingPhase);
          End;
     End;
     SampleBitNow := Not SampleBitNow;
     Sample_2     := Sample_1;
     Level_2      := Level_1;
     Sample_1     := Sample;
     Level_1      := Level
End;

Procedure FilterInput(Level: Boolean; Len: Word);
Begin
     FilterPerFIfO[FilterFIFOWrPtr] := Len;
     FilterLevFIFO[FilterFIFOWrPtr] := Level;
     FilterFIFOWrPtr := (FilterFIFOWrPtr + 1) And FilterFIFOLen;
     If FilterFIFOWrPtr = FilterFIFORdPtr Then Begin
          WriteLn('Fatal: FilterInput() FIFO Overloaded!');
     End;
     If Level Then Inc(FilterSum, Len);
     While Len > 0 Do Begin
          If Len < FilterPerFIFO[FilterFIFORdPtr] Then Begin
               Dec(FilterPerFIFO[FilterFIFORdPtr], Len);
               If FilterLevFIFO[FilterFIFORdPtr] Then Dec(FilterSum, Len);
               Len := 0;
          End Else Begin
               Dec(Len, FilterPerFIFO[FilterFIFORdPtr]);
               If FilterLevFIFO[FilterFIFORdPtr] Then Dec(FilterSum, FilterPerFIFO[FilterFIFORdPtr]);
               FilterFIFORdPtr := (FilterFIFORdPtr + 1) And FilterFIFOLen;
          End
     End
End;

Procedure FilterPreInput(Level: Boolean; Len: Word);
Begin
     While Len > 0 Do Begin
          If Len < FilterSamplingPhase Then Begin
               FilterInput(Level, Len);
               Dec(FilterSamplingPhase, Len);
               Len := 0;
          End Else Begin
               FilterInput(Level, FilterSamplingPhase);
               Dec(Len, FilterSamplingPhase);
               FilterSamplingPhase := FilterSampling;
               FilterNextSample(FilterSum);
          End
      End
End;

Procedure DelayModemInput(Period: Word);
Var  FirstPer: Word;
Begin
     ModemFIFO[ModemFIFOWrPtr] := Period;
     ModemFIFOWrPtr := (ModemFIFOWrPtr + 1) And ModemFIFOLen;
     If ModemFIFOWrPtr = ModemFIFORdPtr Then Begin
          WriteLn('Fatal: DelayModemInput() Modem FIFO Overloaded!');
     End;
     Inc(ModemFIFOTrans);
     While Period > 0 Do Begin
          If Period < ModemFIFO[ModemFIFORdPtr] Then Begin
               FilterPreInput((ModemFIFOTrans And 1) = 0, Period);
               Dec(ModemFIFO[ModemFIFORdPtr], Period);
               Period := 0;
          End Else Begin
              FilterPreInput((ModemFIFOTrans And 1) = 0, ModemFIFO[ModemFIFORdPtr]);
              Dec(Period, ModemFIFO[ModemFIFORdPtr]);
              ModemFIFORdPtr := (ModemFIFORdPtr + 1) And ModemFIFOLen;
              Dec(ModemFIFOTrans);
          End
     End
End;

{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ® Serial Library ¯ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
Functions:
   SelectCOM(COM: Integer) : Boolean
   Detect() : Byte

Procedures:
   InitComm()
   DelayModemInit()
   FilterInit()
   Custom(Mode: Boolean)
   ProcessFrameAddress(Ctrl: Word, Flag, Callsign: String)
   ProcessFrame()
   DisplayTune()
ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}

Function SelectCOM(COM: Byte) : Boolean;
Begin
     SelectCOM := True;
     Case COM Of
     1:   Begin
          CommBase  := $3F8;
          IntMask   := $10;
          IntNum    := $0C;
          End;
     2:   Begin
          CommBase  := $2F8;
          IntMask   := $08;
          IntNum    := $0B;
          End;
     3:   Begin
          CommBase  := $3E8;
          IntMask   := $10;
          IntNum    := $0C;
          End;
     4:   Begin
          CommBase  := $2E8;
          IntMask   := $08;
          IntNum    := $0B;
          End;
     Else SelectCOM := True;
     End;
End;

Function Detect : Byte;
Var  Prt:    Byte;
     Result: Boolean;
     Found:  Boolean;
Begin
     Found  := False;
     Detect := 0;
     For Prt := 4 DownTo 1 Do Begin
          Result := SelectCOM(Prt);
          Port[CommBase] := $0;
          Delay(100);
          If Port[CommBase] = $0 Then Begin
               Port[CommBase] := $FF;
               Delay(100);
               If Port[CommBase] = $FF Then Found := True;
          End;
          If Found Then Begin
               Detect := Prt;
               Exit;
          End;
     End;
End;

Procedure InitComm;
Begin
     DisableInterrupts;
     Port[CommBase + 3] := $03;
     Port[CommBase + 3] := $83;
     Port[CommBase]     := $60;
     Port[CommBase + 1] := $00;
     Port[CommBase + 3] := $03;
     Port[CommBase + 1] := $00;
     Port[CommBase + 4] := $09;
     EnableInterrupts;
End;

Procedure DelayModemInit(Delay: Word);
Begin
     ModemFIFORdPtr := 0;
     ModemFIFO[0]   := Delay;
     ModemFIFOWrPtr := 1;
     ModemFIFOTrans := 1;
End;

Procedure FilterInit(Len, Sampling: Word);
Begin
     FilterFIFORdPtr     := 0;
     FilterPerFIFO[0]    := Len;
     FilterLevFIFO[0]    := False;
     FilterFIFOWrPtr     := 1;
     FilterSum           := 0;
     FilterSampling      := Sampling;
     FilterSamplingPhase := FilterSampling;
     FilterTimeLen       := Len;
     CorrThreshold       := Len Shr 1;
     Sample_1            := 0;
     Sample_2            := 0;
     Level_1             := False;
     Level_2             := False;
     SampleBitNow        := False;
     SyncStep            := Len Shr 3;
     SampleAver          := 0;
     InterSampleAver     := 0;
End;

Procedure Custom(Mode: Boolean);
Var Prt: Byte;
Begin
     Case Mode Of
     False: Begin
            If Not CheckCRC Then
                 If ItIsError Then Begin
                      TextAttr := $04;
                      Write('CRC Error ');
                 End Else Begin
                      TextAttr := $02;
                      Write('CRC Ok    ');
            End;
            TextAttr := $09;
            Write(Time);
            TextAttr := $07;
            WriteLn(' ', Callsign, FrameCtl);
            End;
     True:  Begin
            TextAttr := $0F;
            For Prt := 1 To Length(DataFrame) Do Begin
                 Case DataFrame[Prt] Of
                 #13: If Prt <> Length(DataFrame) Then WriteLn;
                 #10, #7: Begin End;
                 Else Write(DataFrame[Prt]);
                 End;
            End;
            Inc(Prt);
            WriteLn;
            End;
     End;
End;

Procedure ProcessFrameAddress(Var Ctrl: Word; Var Flag, Callsign: String);
Var P, L:      Word;
    Prt:       Byte;
    Buff:      Char;
    Temp, Res: String;
Begin
     P := 0;
     While (P < FramePtr - 2) And ((FrameBuff[P] And 1) = 0) Do Inc(P);
     Ctrl     := P + 1;
     P        := 0;
     Callsign := '';
     Flag     := '';
     While P + 7 <= Ctrl Do Begin
          For L := 1 To 6 Do Begin
               Callsign := Callsign + (Chr(FrameBuff[P] Shr 1));
               Inc(P)
          End;
          Callsign := Callsign + '-' + Chr(((FrameBuff[P] Shr 1) And $F) + 65) + '>';
          If FrameBuff[P] >= $80 Then Flag := '-' Else Flag := '+';
          Inc(P)
     End;
     If P <> Ctrl Then Flag:= '!' + Flag;
End;

Procedure ProcessFrame;
Var B:              Word;
    Ch:             Char;
    Ctrl:           Byte;
    Flag:           String;
Begin
     Beep;
     ProcessFrameAddress(B, Flag, Callsign);
     If B <= FramePtr - 1 - 2 Then Begin
          Ctrl := FrameBuff[B];
          Inc(B);
          FrameCtl := '';
          If (Ctrl And $F) = 1 Then     FrameCtl := 'RR' + toStr(Ctrl Shr 5) + Flag
          Else If (Ctrl And 1) = 0 Then FrameCtl := 'I' + Hex(Ctrl) + Flag
          Else If Ctrl = 3 Then         FrameCtl := 'UI'
          Else If Ctrl = $3F Then       FrameCtl := 'SABM' + Flag
          Else If Ctrl = $53 Then       FrameCtl := 'DISC' + Flag
          Else                          FrameCtl := 'REJ' + Flag
	  End;
          If B <= FramePtr - 1 - 2 Then Begin
	       FrameCtl := FrameCtl + ' ' + Hex(FrameBuff[B]);
               Inc(B)
	  End;
          Custom(False);

          DataFrame := '';
          If B < FramePtr - 2 Then Begin
               For B := B to FramePtr - 1 - 2 Do Begin
               Ch := Chr(FrameBuff[B]);
               DataFrame := DataFrame + Ch;
          End;
          Custom(True);
     End;
End;

Procedure DisplayTune;
Var  Tune:       String[19];
     Ampl:       String[10];
     OldX, OldY: Byte;
     Freq, Amp:  Word;
     Bin:        Integer;
     Prt:        Byte;
Begin
     Amp := SampleAver Div CorrThreshold;
     If Amp > 9 Then Amp := 9;
     Bin := (InterSampleAver Div (CorrThreshold Div 4));
     If Bin > 9 Then Bin := 9 Else If Bin <- 9 Then Bin := -9;
     Ampl := 'úúúùùÄÄÍÍ';
     Tune := 'ÍÍÍÍÍÄÄÄùúùÄÄÄÍÍÍÍÍ';
     For Prt := 1 To 1 + Amp Do Ampl[Prt] := #254;
     Tune[10 - Bin] := #31;
     OldX := WhereX; OldY := WhereY;
     GotoXY(1, 1);
     TextAttr := $29; Write(' ', #16#16, ' KLI Data Shaper      ');
     TextAttr := $2A; Write(Time);
     TextAttr := $2B; If CheckCRC Then Write(' CRC ') Else Write(' NoC ');
     TextAttr := $2C; If RedirectSound Then Write('Aud ') Else Write('Bel ');
     TextAttr := $2F;
     Write('Vol ', Ampl, ' ');
     TextAttr := $2E;
     Write('Dev ', Tune, ' ');
     GotoXY(OldX,OldY);
End;

{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ® Main Program ¯ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}

Var
     Delay, Width, Sample: Word;
     Stop, Empty: Boolean;
     Period:      Word;
     Key:         Char;
     SerialPort:  Byte;
Begin
     CursorOff;
     TextColor(7);
     TextBackground(0);
     ClrScr;
     WriteLn(' ', #16#16,' KLI Data Shaper');
     WriteLn;
     TextAttr := $0F;
     Write('ÚÄBismillahi-r-Rahmani-r-RahimÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');
     Write('³ KLI Data Shaper Decoder 1.01 * Arman Yusuf, S.Kom - YB0KLI ³                 ³');
     Write('³ http://groups.yahoo.com/group/radio-paket/files            ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´');
     Write('³ Drop your mail to: arman@mik.co.id                         ³  Bell 202 AX25  ³');
     Write('ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
     TextAttr := $03;
     Write('                Portion of basic software (C) by Pawel Jalocha, SP9VRC of PKTMON');
     Write('             Portion of basic hardware (C) by W. F. Schroeder, DL5YEC of HAMComm');
     WriteLn;
     TextAttr := $07;
     SerialPort := Detect;
     If SerialPort = 0 Then Begin
          WriteLn('Fatal: KLI Data Shaper Demodulator not found...');
          Halt(0);
     End Else Begin
          GotoXY(64, 4);
          WriteLn('Demod'' on COM', SerialPort, ':');
     End;
     GotoXY(1, 11);

     {AFSK: Set Mark 1200 Hz, Space 2200 Hz}
     Delay         := 2266;
     Width         := 1133;
     Sample        := 2400;

     CheckCRC      := True;
     RedirectSound := False;

     {Prepare Interrupt}
     InitTimer;
     InitComm;
     InitBuffer(PeriodBuffer);
     DelayModemInit(Round(TimerFreq / Delay));
     FilterInit(Round(TimerFreq / Width), Round(TimerFreq / Sample));
     ConnectInterrupt;

     Stop := False;
     Repeat
          Repeat
               ReadBuffer(PeriodBuffer, Period, Empty);
	       If Not Empty Then DelayModemInput(Period)
	  Until Empty;
          DisplayTune;
          If KeyPressed Then Begin
               TextAttr := $03;
               Beep;
               Case ReadKey Of
               #27: Begin Stop := True;
                    WriteLn('ESC: Program terminated normally.'); End;
               #59: Begin TextMode(CO80 + Font8x8);
                    CursorOff; TextAttr := $03;
                    WriteLn; WriteLn('F1: Compressed screen mode is activated.'); End;
               #60: Begin TextMode(CO80);
                    CursorOff; TextAttr := $03;
                    WriteLn; WriteLn('F2: Normal screen mode is activated.'); End;
               #61: Begin CheckCRC := Not CheckCRC;
                    Write('F3: CRC checking is ');
                    If CheckCRC Then WriteLn('ON.') Else WriteLn('OFF.'); End;
               #62: Begin RedirectSound := Not RedirectSound;
                    Write('F4: Audio redirect is ');
                    If RedirectSound Then WriteLn('ON.') Else WriteLn('OFF.'); End;
               End;
          End;
     Until Stop;
     DisconnectInterrupt;
     TextAttr := $07;
     TextMode(CO80);
     CursorOn;
End.