{***************************************************************************}
{*  Program : I2C sender                                                   *}
{*  Data    : 24 sierpnia 1997                                             *}
{*  J‘zyk   : Turbo Pascal 7.0 (Borland Int.)                              *}
{*  Autor   : Micha’ Lankosz   (http://student.uci.agh.edu.pl/~lanki/)     *}
{*                                                                         *}
{*                                                                         *}
{*  Prosty program do obs’ugi syntezera PLL TSA6057 z wykorzystaniem       *}
{*  portu drukarkowego.                                                    *}
{*                                                                         *}
{***************************************************************************}
{   Schemat po’†cze¤ we wtyczce DB-25                                       }
{                                                                           }
{                                                                           }
{   pin  LPT:   14       12    13       1     2   25                        }
{                                                                           }
{                o        o    o        o     o   o                         }
{                |        |    |        |     |   |                         }
{                |    ----|----|---*----|--|<--   |  1N4148                 }
{                |    |   |    |   |    |         |                         }
{               | |  | |  |    |  | |  | |        |                         }
{       4x 6k8  | |  | |  |    |  | |  | |        |                         }
{                |    |   |    |   |    |         |                         }
{                |    *---*    *---*    |         |                         }
{                |  |/    |    |    \|  |         |                         }
{       2x NPN   ---|     |    |     |---         |                         }
{      (BC 528)     |\    |    |    /|            |                         }
{                     v   |    |   v              |                         }
{                     |   |    |   |              |                         }
{                     |   |    |   |              |                         }
{                     ----|----|---*---------------                         }
{                         |    |   |                                        }
{                         |    |   |                                        }
{                         o    o   o                                        }
{                                                                           }
{   magistrala IIC       SDA  SCL  GND                                      }
{                                                                           }
{***************************************************************************}
{   Opis wyprowadze¤ portu LPT                           }
{  ----------------------------------                    }
{ |   |  port  | bit |  nazwa |  pin |                   }
{ |---+--------+-----+--------+------|                   }
{ |WY |  LPTw  |  0  |   SCL  |   1  |                   }
{ |   | (LPT+2)|  1  |   SDA  |  14  |                   }
{ |---+--------+-----+--------+------|                   }
{ |WE |  LPTr  |  4  |   SCL  |  13  |                   }
{ |   | (LPT+1)|  5  |   SDA  |  12  |                   }
{  ----------------------------------                    }

uses crt,dos;
const
{ Dla LPT2: }
  LPTw=$278+2;
  LPTr=$278+1;

{ Dla LPT1: }
{ LPTw=$378+2;
  LPTr=$378+1;}

var
  Freq,FreqZad,Li:LongInt;              { Cz‘stotliwožŤ zadana      }
  Fref           :Byte;                 { CzestotliwožŤ odniesienia }
  XmitBuf        :array[0..5]of byte;   { Dane do wys’ania          }
  ViewTransfer   :Boolean;              { Czy wyswietlac proces transmisji }
  Ch             :Char;                 { Czytany klawisz           }
  i              :Byte;                 { Zmienna pomocnicza        }

  procedure Wait;
  { Procedura op˘§nienia - transmisja nie mo§e byŤ szybsza ni§ 100kHz }
  var i:Word;
  begin
    delay(1);
{   delay(0);      - mo§na spr˘bowaŤ daŤ tak }
  end;

  procedure Wyslij; { programuje TSA6057 }
  var
    ACK         :Boolean;       { Czy jest potwierdzenie }
    DBnr        :Byte;          { Numer bajtu wysy’anego }
  const{SCL,SDA}                { Sta’e okrežlaj†ce stany na porcie }
  { dla ustawienia   dla odczytania }
    magw00=$00;        magr00=$00;
    magw10=$01;        magr10=$10;
    magw01=$02;        magr01=$20;
    magw11=$03;        magr11=$30;

    procedure WriteByte(B:Byte);
    { wysy’a jeden bajt }
    var
      i,bit:byte;
    begin
      for i:=7 downto 0 do
      begin
        bit:=B and (1 shl i);
        if bit<>0 then
        begin
          if ViewTransfer then Write('1');
          Port[LPTw]:=magw01;
          Wait;
          Port[LPTw]:=magw11;
          { czekaj, a§ szyna SCL b‘dzie w stanie HI : }
          repeat until (Port[LPTr] and magr10)=magr10;
          if ViewTransfer then Write('.');
          Wait;
          Port[LPTw]:=magw01;
        end
        else
        begin
          if ViewTransfer then Write('0');
          Port[LPTw]:=magw00;
          Wait;
          Port[LPTw]:=magw10;
          { czekaj, a§ szyna SCL b‘dzie w stanie HI : }
          repeat until (Port[LPTr] and magr10)=magr10;
          if ViewTransfer then Write('.');
          Wait;
          Port[LPTw]:=magw00;
        end;
        Wait;
      end;
      Port[LPTw]:=magw01;     { for ACK }
      Wait;
    end;

    procedure WaitACK;
    { czekaj na bit potwierdzenia }
    begin
      { czekaj a§ odbiornik poda LO na lini‘ SDA }
      if ViewTransfer then Write('Wait ACK... ');
      repeat until (Port[LPTr] and magr11)=magr00;
      if ViewTransfer then Write('OK, wait for release SDA...');
      Port[LPTw]:=magw11; { HI na SCL }
      Wait;
      Port[LPTw]:=magw01; { LO na SCL }
      Wait;
      { czekaj, a§ b‘dzie HI na SDA }
      repeat until (Port[LPTr] and magr11)=magr01;
      if ViewTransfer then Writeln(' OK! ');
      Wait;
    end;

    procedure start;
    { generuje warunek startu }
    begin
      Port[LPTw]:=magw11;
      if ViewTransfer then Write('S');
      repeat until (Port[LPTr] and magr11)=magr11;
      if ViewTransfer then Write(' ... ');
      Wait;
      Port[LPTw]:=magw10;
      Wait;
      Port[LPTw]:=magw00;
      Wait;
      if ViewTransfer then Writeln('Start condition OK !');
    end;

    procedure stop;
    { generuje warunek stopu }
    begin
      if ViewTransfer then Write('P... ');
      Port[LPTw]:=magw00;
      Wait;
      Port[LPTw]:=magw10;
      Wait;
      Port[LPTw]:=magw11;
      Wait;
      if ViewTransfer then Writeln('Stop condition OK !');
    end;

  begin
    start;
    for DBnr:=0 to 5 do
    begin
      if ViewTransfer then Write('Data transfer no ',DBnr,' = ');
      WriteByte(XmitBuf[DBnr]);
      if ViewTransfer then Writeln;
      if ViewTransfer then Write('               ACK = ');
      WaitACK;
    end;
    stop;
  end;

  procedure ZapiszBit(Poz,B:Byte);
  { ustawia pojedynczy bit w buforze danych }
  var
    Arr,Pz      :Byte;
  begin
    Arr:=Poz div 8;
    Pz:=1 shl (Poz mod 8);
    if B=1 then XmitBuf[Arr]:=XmitBuf[Arr] or Pz
    else
    XmitBuf[Arr]:=XmitBuf[Arr] and not Pz;
  end;

begin
  ViewTransfer:=False;
{  ViewTransfer:=True;}
  XmitBuf[0]:=$C4; { 11000100  -  1   1   0   0   0   1   0/1  0    }
  XmitBuf[1]:=$00; { 00000000  -  0   0   0   0   0   0   0/1  0/1  }
  XmitBuf[2]:=$01; { ???????1     s6  s5  s4  s3  s2  s1  s0   CP   }
  XmitBuf[3]:=$00; { ????????     s14 s13 s12 s11 s10 s9  s8   s7   }
  XmitBuf[4]:=$A0; { 101000??     r1  r2  a/f op  -   bs  s16  s15  }
  XmitBuf[5]:=$00; { 00000000     t1  t2  t3  -   -   -   -    -    }
  Fref:=25;
  FreqZad:=145000; { Zadana cz‘stotliwožŤ }
  Freq:=FreqZad div Fref;
  Window(1,1,80,6);
  ClrScr;
  Writeln('f  - podanie czestotliwosci                         7 -  krok w g˘r‘ ');
  Writeln('k  - podanie kroku syntezy                          1 -  krok w d˘’  ');
  Writeln('p  - zal/wyl zwiekszonego pradu pompy ladunku       8 -  +100 kHz    ');
  Writeln('q  - wyjscie                                        2 -  -100 kHz    ');
  Writeln('                                                    9 -  + 1  MHz    ');
  Write  ('                                                    3 -  - 1  MHz    ');
  Window(1,7,80,25);
  ClrScr;
  repeat
    Write(Freq*Fref:7,' [',Fref,']  >');
    Ch:=Upcase(Readkey);
    Writeln{(Ch)};
    case Ch of
    '?':begin
          Writeln('f  - podanie czestotliwosci');
          Writeln('k  - podanie kroku syntezy');
          Writeln('p  - zal/wyl zwiekszonego pradu pompy ladunku');
          Writeln('q  - wyjscie');
        end;
    'F':begin
          Write('Podaj czestotliwosc > ');
          Readln(FreqZad);
        end;
    'K':begin
          Write('Podaj krok syntezy (10,25) > ');
          Readln(Fref);
        end;
    'P':begin
          Write('Zalaczyc duzy prad pompy ladunku [T/N] ? > ');
          if UpCase(Readkey)='T' then ZapiszBit(16,1) else ZapiszBit(16,0);
          Writeln;
        end;
    'Q',#27:;
    '7':Inc(FreqZad,Fref);
    '1':Dec(FreqZad,Fref);
    '8':Inc(FreqZad,100);
    '2':Dec(FreqZad,100);
    '9':Inc(FreqZad,1000);
    '3':Dec(FreqZad,1000);
    end;
{          if Fref=1 then begin ZapiszBit(38,0); ZapiszBit(39,0) end;}
          if Fref=10 then begin ZapiszBit(38,1); ZapiszBit(39,0) end;
          if Fref=25 then begin ZapiszBit(38,0); ZapiszBit(39,1) end;
          Freq:=FreqZad div Fref;
          if Freq>$1FFFF then Freq:=$1FFFF;
{          Writeln('czestotliwosc    krok ');
          Writeln(Freq*Fref:9,Fref:11,'    [kHz]' );}
          for i:=0 to 16 do  ZapiszBit(i+17, Freq and (1 shl i) shr i );

    Wyslij;

  until Ch in['Q',#27];
end.