//{$O+,N+,F+,B-,D-,L-,S-,R-}
unit porto;

Interface
uses //Crt,dos,
common,friend;
var      rate : realType;
         gain : integer;
procedure PortInfo(var target:typ_skl; count:word; var Gain:integer;
                   var rate:realType; var kontr:boolean; var board_num:integer;
                   var trigger,mode,chanlo,int_level:integer;
                   var base_adr:integer; var clock_freq:real;var spow:byte;
                   var err_code:integer; var triglev:byte; var sklSt:word);
 procedure ZPortu(board_num,chanlo,mode,trigger, count:word;
                  var clock_freq,rate:real; var base_adr:integer;
                  var target:typ_skl;var err_code:integer;kontr : boolean;
                  znt:boolean;triglev:byte;sklSt:word);

 procedure fromPortToHeap(board_num,chanlo,mode,trigger:integer;
  var clock_freq:real;var rate:realType; var base_adr:integer;
  var target:typ_skl; var err_code:integer;
  var RzS:word; var rez:word; p,znt:boolean; var trigLev:byte;
  var sklSt:word; HeapSize:byte;var tref:trefTyp);


Implementation
 var

              adres1,adres2 : integer;        { deklaracje ze wzgledu na }
                intflg_glob : integer;        { obsluge Handler'a 0 }
                oldvec_glob : pointer;

                    mem_seg,mem_off : integer;
                              count : word;
                               znak : char;
                             chanlo : integer;
                            KcTGlob : word;
                           err_code : integer;
                           base_adr : integer;
const grubosc=bufor;                             {grubosc plastra na stercie}

function nl:string; begin nl:=#10#13 end;

 procedure Opt(var eh:integer);   {wczytuje z klawiatury cyfre ignorujac i}
 var x,y,i,j : byte;              {kasujac wszystkie inne znaki; cyfre ta }
        znak : char;              {wpisuje w miejscu, gdzie byl kursor    }
  begin                           {przed wywolaniem procedury             }
//  x:=WhereX; y:=WhereY;
i:=0;
   repeat Inc(i,2);no_jak(znak); val(znak,eh,err_code) until err_code=0;
//   GoToXY(x,y);
  // for j:=0 to i-1 do write(cons,' ');
  // GoToXY(x,y);
   //writeln(cons,eh);
  end;{Opt}
                (*
 procedure klucz0(ba2:word);
 var   i,k : byte;
     p,x,y : word;
 begin
  if not ((p or $AF = $AF) and (p and $20 =$20)) then
   begin                                            {chwilowo; p or $8F=$8F}
//    TextAttr := magenta;
     repeat
      p:=port[ba2];
      if p or $EF > $EF then write(cons,' zamknij IP1 !'); {14 - xxx0xxxx}
      if p or $DF = $DF then write(cons,' zwolnij IP2 !');
                   {13 - xx0xxxxx chwilowo xx1xxxxx; bedzie p or $DF > $DF}
      if p or $BF > $BF then write(cons,' zamknij IP3 !'); {11 - x0xxxxxx}
      writeln(cons); GoToXY(1,WhereY-1); delay(20);DelLine;
     until (p or $AF = $AF) and (p and $20 =$20);     {chwilowo; p or $8F=$8F}
                                                     {              x000xxxx}
    TextAttr:=white;
    end;{if}
 end;{klucz0}
              *)    (*
 procedure ciag_imp(wyjscie:byte; opz,ile:longint;adres2:word);
  var i : longint;
      r : byte;
  begin
   r:=wyjscie*16;                      {lokalizacja 1 w I-szych 4-ech bitach}
   case wyjscie of
    1 : wyjscie:=$1F;
    2 : wyjscie:=$2F;
    3 : wyjscie:=$4F;
    4 : wyjscie:=$8F;
   end; {case}
  port[adres2]:=$F;                                    {ustawic wyjscia na 0}
  i:=0;
  repeat               {wytworzyc ciag impulsow 2ms na OP1 | OP2 | OP3 | OP4}
   i:=i+1;
   port[adres2]:=port[adres2] and wyjscie or r;
                                             {np. xx1xxxxx - wpisac 1 do OP2}
   delay(opz);                                                { $CF=11001111}
   port[adres2]:=port[adres2] and $F;                      { zgasic wszystko}
   delay(opz);
  until i=ile;
 end;{ciag_imp}
           *)
 procedure MagnetStop(base_adr,adres1,adres2:integer);
  var i : byte;
  begin
//   ciag_imp(1,1,128,adres2);  {wytworzyc ciag impulsow 2ms na OP1 (znacznik)}
  { repeat delay(2) until (port[adres2] and $60)=$60;}
                                 {czekac az IP2 i IP3=1 chwilowo zablokowane}
   {x11xxxxx tj do zwolnienia przycisku albo az magnet przestanie impulsowac}
end; {MagnetStop}
  (*
procedure MagnetStart(adres2:word;znt:boolean);
 begin
  if not znt then
   begin
    TextAttr := red + blink;
    writeln(cons,'Start magnetofonu - nacisnac IP3');
    repeat
    until port[adres2] and $40 =$40;   {x1xxxxxx}
    GoToXY(1,WhereY-1); DelLine;
    writeln(cons,'zwolnij przycisk IP3 !');
    repeat
    until port[adres2] or $BF = $BF;
   end;{if}
  port[adres2]:=port[adres2] and $2F; {zapalic OP2}
  GoToXY(1,WhereY-1); DelLine;
  TextAttr := white;
 end;{MagnetStart}
   *)     (*
procedure IP1(adres2:word;trigger:integer);
 begin
    klucz0(adres2);
    if trigger = 1 then
    begin
     TextAttr:=yellow+Blink;
     writeln(cons,'START - poslac 1 na IP1 !');
   repeat
   klucz0(adres2);
   until (($10 and port[adres2]) = $10);     {czekac, az pojawi sie 1 na IP1}
    GoToXY(1,WhereY-1); DelLine;
     writeln(cons,'poslac 0 na IP1 ! (uszkodzony przelacznik ?)');
    repeat
    until ((port[adres2] or $EF) = $EF);   {czeka na 0 na IP1 $EF = 11101111}
    GoToXY(1,WhereY-1); DelLine;
   end;{trigger=1}
   TextAttr:=white;
 end;{IP1}
     *)    (*
procedure start(var base_adr,adres1,adres2:integer; triglev:byte; skl_st:word);
 var delta:word; t1:real; t2:longint;
 begin
  inline($FA);
  TextColor(yellow);
  delta:=round(triglev*((4096-skl_st)/100));
  write(cons,'Czekam na napiecie o poziomie wyzwalania');
  t2:=skl_st;
    repeat
     port[adres1] := $ff;                        {przetwarzanie 12-to bitowe}
     t1:=((swap(port[adres1]) or port[base_adr]) shr 4);
     t1:=((swap(port[adres1]) or port[base_adr]) shr 4)-t2;
    until abs(t1)>delta;
    delLine; writeln(cons);
  inline($FB);
  TextColor(white);
 end;{start}
             *)      (*
 procedure jazda(var base_adr,adres1,adres2:integer; var znt:boolean;
                trigger,trigLev:byte;sklSt:word);
 begin
  klucz0(adres2);
  magnetStart(adres2,znt);
  klucz0(adres2);
  if not znt then ip1(adres2,trigger);
  start(base_adr,adres1,adres2,triglev,sklSt);
 end;{jazda}
                       *)
procedure fastdirToHeap(var tref:trefTyp;var base_adr,adres1,adres2:integer;
                  var   RzS : word; var  rez : word; var rate:realType;
                  var     p : boolean;   trigger : byte;       znt : boolean;
                    triglev : byte;        sklst : word;HeapSize : byte);
 label 1, 2;
 var i,j,k,l,zmp : longword;
 begin
  p:=False;
  //writeln(cons,'Procedura FastDir, pobiera pomiary z czestoscia ',rate:7:1, '/s i laduje je na sterte');
//  TextBackground(brown);
 // writeln(cons,'UWAGA czestotliwosc probkowania okreslic experymentalnie!',nl,
   //     'podana tu wartosc nie ma zadnego wplywu na rzeczywista',
     //   ' szybkosc probkowania'); //textBackground(blue);
 // writeln(cons,'Pamietaj o efekcie Picketa!');
//  TextBackground(black);
  l := Grubosc+1;
//  jazda(base_adr,adres1,adres2,znt,trigger,triglev,sklst);
//  inline($FA);
//  TextColor(blue);
  for j:=0 to HeapSize do                     {ladowanie sterty}
   begin
    k:=0;
    repeat
//     port[adres1] := $ff;                        {przetwarzanie 12-to bitowe}
     for zmp:=1 to 4 do;
//     tref[j]^[k]:=(swap(port[adres1]) or port[base_adr]) shr 4;
     inc(k);         (*
     if((port[adres2] or $DF) = $DF) then   {(xx0xxxxx)}
      begin                                  {Przerwanie OPERATORA D=13  F=15}
       write(cons,'Zaladowano ',(j+1)*(grubosc+1)+k ,' danych');
       writeln(cons,'Kontynuowac ? - tak, to IP1; nie, to IP3');
       repeat
        klucz0(adres2);
        i:=port[adres2];                                  {czytac port 1 raz!}
        if (i and $40=$40) then goto 1;  {IP3=true, gdy port[adres2]=x1xxxxxx}
       until (i and $40=$40) or (i and $10=$10);               {a $40=01000000}
       klucz0(adres2);                {poczekac, az zostanie zwolniony klucz!}
      end              *)
    until (k>=l);
   end;{j; koniec ladowania sterty}
   p:=true;
   goto 2;
1:;// writeln(cons,'przerwanie OPERATORA');
2: RzS:=j;
   if (k<l) or (j=0) then rez:=k  else  rez:=0;
   if k>l then;// writeln(cons,'BLAD SYSTEMU - uskodzenie komputera ?');
   if (j=HeapSize) and (k=l)  then;// writeln(cons,'pelna sterta');
//  inline($FB);
//  TextColor(white);
 end;{fastdir}

 procedure kontdirToHeap(var tref:trefTyp;var adres1,adres2:integer;
		  var   RzS : word;     var  rez : word;
                  var  rate : realType; var    p : boolean;  trigger : byte;
                        znt : boolean;triglev:byte;sklst:word;HeapSize:byte);
 label 1, 2;
 var i,j,k,l:longword;
 begin
 p:=False;
 //writeln(cons,'          --------- Procedura kontdir ----------',nl,
   //      ' czyta probki z zadana czestotliwoscia i laduje je na sterte',nl,
     //    'max czestotliwosc probkowania -  15 kHz !');
  l := Grubosc+1;
//  jazda(base_adr,adres1,adres2,znt,trigger,triglev,sklst);
//  inline($FA);
//  TextColor(blue);
  for j:=0 to HeapSize do                  { *** - ladowanie sterty - *** }
   begin
    k:=0;
  //  repeat
//     port[adres2]:=port[adres2] and $F7;     {ustawic bit xxxx0xxx w b.a.+2 }
     repeat                                  {wait for intflg flag}
//     until ((8 and port[adres2]) = 8);       {probkowanie - czeka na usta-}
                                             {wienie bitu xxxx1xxx w b.a.+2}
//     port[adres1] := $ff;                    {przetwarzanie 12-to bitowe}
  //   repeat                                  {czeka na koniec konwersji,}
//     until ((port[adres2] and $80) <> $80);  {EOC=1, tj az b.a.+2 = 0xxxxxxx}
//     tref[j]^[k]:= (swap(port[adres1]) or port[base_adr]) shr 4;
     inc(k);
//     if((port[adres2] or $DF) = $DF) then   {(xx0xxxxx)}
      begin                                  {Przerwanie OPERATORA D=13  F=15}
       //write(cons,'Zaladowano ',(j+1)*(grubosc+1)+k ,' danych');
       //writeln(cons,'Kontynuowac ? - tak, to IP1; nie, to IP3');
       repeat
//        klucz0(adres2);
//        i:=port[adres2];                                  {czytac port 1 raz!}
        if (i and $40=$40) then goto 1;  {IP3=true, gdy port[adres2]=x1xxxxxx}
       until (i and $40=$40) or (i and $10 = $10);            {a $40=01000000}
//       klucz0(adres2);                {poczekac, az zostanie zwolniony klucz!}
      end
    until (k>=l);
   end;{j; koniec ladowania sterty}
   p:=true;
   goto 2;
1:;// writeln(cons,'przerwanie OPERATORA');
2: RzS:=j;
   if (k<l) or (j=0) then rez:=k else rez:=0;
   if k>l then;// writeln(cons,'BLAD SYSTEMU - uszkodzenie ?');
   if (j=HeapSize) and (k=l)  then;// writeln(cons,'pelna sterta');
//   TextColor(white);
// inline($FB);
 end;{kontdir}

procedure direcToHeap(var tref:trefTyp;board,trigger:integer;
   var target:typ_skl;var err_code:integer; var RzS:word;var rez:word;
   chanlo:integer;var p:boolean; znt : boolean;var rate:realType;
   var triglev:byte;
   base_adr:integer;var sklst:word;HeapSize:byte);

var
    ofs_tmp, seg_tmp,adres1,adres2 : integer;
                                 i : word;
begin
// TextColor(white); textBackGround(blue);
 //writeln(cons,'Czytanie danych zostanie przerwane po poslaniu 0 na wejscie IP2');
// TextColor(white);
 adres1:=base_adr+1; adres2:=base_adr+2;
// port[adres2] := 8 or chanlo;
// TextColor(red);
 //writeln(cons,'ENTER jesli bez kontroli probkowania, cokolwiek jesli tak');
 no_jak(znak);
// TextColor(white);
 if znak=#13 then
 fastdirToHeap(tref,base_adr,adres1,adres2,RzS,rez,rate,p,trigger,znt,triglev,
                 sklst,HeapSize)
             else
 kontdirToHeap(tref,adres1,adres2,RzS,rez,rate,p,trigger,znt,triglev,
                 sklst,HeapSize);
end;   {direcToHeap}

 procedure fromPortToHeap(board_num,chanlo,mode,trigger:integer;
  var clock_freq:real;var rate:realType; var base_adr:integer;
  var target:typ_skl; var err_code:integer;
  var RzS:word; var rez:word; p,znt:boolean; var trigLev:byte;
  var sklSt:word; HeapSize:byte;var tref:trefTyp);


 var                           i,j,k,l : word;
              old_cntr_data,config_num,
                       seg_tmp,ofs_tmp : integer;
                          divisor_real : real;
  begin {--------- segment glowny czyt ------------}

    direcToHeap(tref,board_num,trigger,target,err_code,RzS,rez,
                        chanlo,p,znt,rate,triglev,base_adr,sklst,HeapSize);
   magnetStop(base_adr,base_adr+1,base_adr+2);
 end;{fromPortToHeap}

procedure kontdir(var base_adr:integer;chanlo:integer; count:word;rate:real;
            var target:typ_skl;znt:boolean; trigger,triglev:byte;sklSt:word);
 var adres1,adres2 : integer;
     KcT,mem_off,mem_seg:word;
 begin
  adres1 := base_adr+1; adres2:=base_adr+2;
//  mem_off:= ofs(target);
//  mem_seg:= seg(target);
  KcT:=mem_off+(count shl 1) - 1;
// jazda(base_adr,adres1,adres2,znt,trigger,triglev,sklst);
// inline($FA);
  repeat
//     port[adres2]:=port[adres2] and $F7;     {ustawic bit xxxx0xxx w b.a.+2 }
 //    repeat                                  {wait for intflg flag}
   //  until ((8 and port[adres2]) = 8);       {probkowanie - czeka na usta-}
                                             {wienie bitu xxxx1xxx w b.a.+2}
//     port[adres1] := $ff;                    {przetwarzanie 12-to bitowe}
//     repeat                                  {czeka na koniec konwersji,}
  //   until ((port[adres2] and $80) <> $80);  {EOC=1, tj az b.a.+2 = 0xxxxxxx}
//     memW[mem_seg:mem_off]:= (swap(port[adres1]) or port[base_adr]) shr 4;
     inc(mem_off,2);
  until (mem_off>=KcT);
//  inline($FB);
 end;{kontdir}

procedure fastdir(var base_adr:integer;chanlo:integer; count:word;rate:real;
            var target:typ_skl;znt:boolean; trigger,triglev:byte;sklSt:word);
 var        adres1,adres2:integer;
      KcT,mem_seg,mem_off,zmp:word;
 begin
  adres1:=base_adr+1; adres2:=base_adr+2;
//  mem_off:= ofs(target);
//  mem_seg:= seg(target);
  KcT:=mem_off+(count shl 1)-1;
//  jazda(base_adr,adres1,adres2,znt,trigger,triglev,sklst);
//  inline($FA);
    repeat
//     port[adres1] := $ff;                        {przetwarzanie 12-to bitowe}
     for zmp:=1 to 4 do;                         {opoznienie}
//     memW[mem_seg:mem_off]:= (swap(port[adres1]) or port[base_adr]) shr 4;
     inc(mem_off,2);
    until (mem_off >=KcT);
//  inline($FB);
 end;{fastdir}

 procedure direct(board,count:word;trigger :byte; var target:typ_skl;
                  var err_code : integer;chanlo : integer;Base_adr:integer;
                  rate:real;kontr:boolean;
                   znt:boolean; triglev:byte;sklSt:word);
 begin
//  port[base_adr+2] := 8 or chanlo;
  if not kontr then
   fastdir(base_adr,chanlo,count,rate,target,znt,trigger,triglev,sklSt)
    else
   kontdir(base_adr,chanlo,count,rate,target,znt,trigger,triglev,sklSt)
 end;   {direct}

 procedure ZPortu(board_num,chanlo,mode,trigger, count:word;
                  var clock_freq,rate:real; var base_adr:integer;var target:typ_skl;
                  var err_code:integer;kontr : boolean;
                  znt:boolean;triglev:byte;sklSt:word);

 var               i,j,k,l : word;
              old_cntr_data,config_num,
                       seg_tmp,ofs_tmp : integer;
                          divisor_real : real;
  begin {--------- segment glowny czyt ------------}

    direct(board_num, count, trigger, target, err_code,
               chanlo,base_adr,rate,kontr,znt,triglev,sklSt);
 end;{ZPortu}


procedure PortInfo(var target:typ_skl; count:word; var Gain:integer;
                   var rate:realType; var kontr:boolean; var board_num:integer;
                   var trigger,mode,chanlo,int_level:integer;
                   var base_adr:integer; var clock_freq:real;var spow:byte;
                   var err_code:integer;var triglev:byte; var sklSt:word);
  var
          i,adres1,adres2,c1dat : word;
                        lancuch : PathStr;
begin   {---------- segment glowny --------------------}
//  ClrScr; TextBackground(black); TextColor(white);
  //writeln(cons,'---------------------------------------------------------------');
  //writeln(cons,'Program czyta dane z przetwornika analogowo-cyfrowego MetraByte');
//  TextColor(green); writeln(cons,'A.P. 17.09.1989'); TextColor(white);
 // writeln(cons,'---------------------------------------------------------------');
  board_num := 0;                              {nr kolejny plyty przetwornika }
  int_level := 3;
  base_adr := $300; adres1:=base_adr+1; adres2:=base_adr+2;
  clock_freq:=1000000.0;
// TextColor(red);
 //writeln(cons,'Czulosc',nl,'kod    zakres',nl,' 0   +- 5    V',nl,
// ' 1  +- 10    V',nl,' 2     10    V',nl,' 3   +- 0.5  V',nl,
 //' 4      1.0  V',nl,' 5   +- 0.05 V',nl,' 6      0.1  V',nl,
 //' 7   +- 0.01 V',nl,' 8      0.02 V',nl,'--------------------------------');
// i:=WhereX;
// repeat GoToXY(i,WhereY); Opt(Gain); until (Gain <=8) and (gain>=0);
// GoToXY(1,WhereY-12); for i:=1 to 12 do DelLine;
// GoToXY(8, WhereY-1);
//writeln(cons,'        ',Gain);
 if Gain >0 then Gain:=Gain+7;
// port[base_adr+3]:=(port[base_adr+3] and $F0) or Gain;  {nastawa wzmocnienia}
 write ('Numer kanalu  (1) ');
 Opt(chanlo);
 case gain of 0..8,10,12,14 : sklSt:=2048 else sklSt:=0 end; {parametry startu}
 triglev:=par_int('Prog reakcji w % zakresu');
 repeat spow:=par_int('Spowolnienie magnetofonu <1,4>')
 until (spow>0) and (spow<5);

  mode := 1;                            {1-tryb interrupt -  praca w 'tle'}
  mode := 0;                            {0-tryb bezposredni}
  trigger := 1;                         {wyzwalanie wewnetrzne}
// TextColor(red);
 rate:=par_fiz('tempo probek/s (max 23256 Hz bez kontroli zakresow {$R-})');

//   port[base_adr+2]:=chanlo;       {zniesc przerwanie, zachowac kanal}
   c1dat := round(clock_freq/rate);
   rate:=clock_freq/c1dat;
//   TextColor(green);
   //writeln(cons,'probkowanie z czestotliwoscia ',rate:5:2);
//   TextColor(white);
//   port[base_adr+7]:=182; {generowac fale prostokatna}

//   port[base_adr+6]:=lo(c1dat);     {konfigurow. licznika; pobierany jest}
//   port[base_adr+6]:=hi(c1dat);     {najpierw dolny a potem gorny bajt   }
end ;{PortInfo}

BEGIN
// Writeln(cons,'6. Porto');
 base_adr:=$300;
END.
