unit dallrdu;
{$I define.pas}
interface
uses
  modutype, chrntype, dallutl,
  Stru
  {$IFDEF WINDOWS}
  ,wintypes, comtype, comport
  {$ENDIF}
  ,portu

  ;
const
  drInterrupted = -1;

{$DEFINE USETIMEOUT}

function GetTouchID(APortNr:integer; var ATouchID:TMediumID):boolean;
{returns true and fills ATouchID if some touch is on the port APortNr,
 otherwise returns false and ATouchID is undefined}


function TouchToFile(APortNr:integer; AFileName:string):integer;
{.. transfers data from MemTouch on port APortNo to given AFileName;
 returns 0 on success, otherwise error code}

function FileToTouch(APortNr:integer; AFileName:string):integer;
{.. transfers data from file AFileName to given port; returns 0
 if ok, otherwise error code}

{$IFNDEF WINDOWS}
function Scan(APortNr:integer):integer;
{waits on given port for the MemTouch to exchange data, exits
 after successful transfers (result=0) or if interrupted (result<>0)}
{$ENDIF}

function TouchBlockToBuf(APortNr:integer; Start,Size:word; var Buf):boolean;
  function TouchToTimeTable(APortNr:integer; var T:TChTable):boolean;
  {just for sending only part with real data, assuming
   that T.Upconfig is already READ from touch!! - deciding
   how much of data to read}

function BufToTouchBlock(APortNr:integer; var Buf; Start,Size:word):boolean;
  function TouchTableToTouch(APortNr:integer; ASize:word; var T:TChTable):boolean;
  {sending just ASize bytes from T.TouchTable to the touch memory
   - plus DownConfig and UpConfig}

implementation
uses {crt,}mytype, binhex, globals,
{$IFDEF USEDLL}
  msgproc, logproc,
{$ELSE}
  msgu,{prog box, show msg,} timer
{$ENDIF}
  ;
const
{$IFDEF USETIMEOUT}
  TimedOut:boolean = false;
{$ENDIF}
  TransProgBox:pointer = nil;

type
 TScratchPad = record			{delka TScratchPad je max $20}
   TA1,TA2,ES:byte;
   Data:array[0..$3ff] of byte; {pouze pro read/compare ram je $400}
   Len:integer;
 end;

const
  hex:array[0..15] of char=('0','1','2','3','4','5','6','7','8','9',
				 'A','B','C','D','E','F');
  crc_table:array[0..$ff] of byte=(
  0,94,188,226,97,63,221,131,194,156,126,32,163,253,31,65,
  157,195,33,127,252,162,64,30,95,1,227,189,62,96,130,220,
  35,125,159,193,66,28,254,160,225,191,93,3,128,222,60,98,
  190,224,2,92,223,129,99,61,124,34,192,158,29,67,161,255,
  70,24,250,164,39,121,155,197,132,218,56,102,229,187,89,7,
  219,133,103,57,186,228,6,88,25,71,165,251,120,38,196,154,
  101,59,217,135,4,90,184,230,167,249,27,69,198,152,122,36,
  248,166,68,26,153,199,37,123,58,100,134,216,91,5,231,185,
  140,210,48,110,237,179,81,15,78,16,242,172,47,113,147,205,
  17,79,173,243,112,46,204,146,211,141,111,49,178,236,14,80,
  175,241,19,77,206,144,114,44,109,51,209,143,12,82,176,238,
  50,108,142,208,83,13,239,177,240,174,76,18,145,207,45,115,
  202,148,118,40,171,245,23,73,8,86,180,234,105,55,213,139,
  87,9,235,181,54,104,138,212,149,203,41,119,244,170,72,22,
  233,183,85,11,136,214,52,106,43,117,151,201,74,20,246,168,
  116,42,200,150,21,75,169,247,182,232,10,84,215,137,107,53);

  spa:word=0;
  old_date=$1ffa;

{var
  pom:TScratchPad;
  TouchID:TMediumID;
  vstup,vystup:file;}


procedure SetTimedOut(onoff:boolean);
begin
  if onoff then begin
    ShowMessage('Medium nebylo vloženo - timeout', smError, 0);
  end;
  TimedOut := onoff;
end;

function TouchReset(n:byte):boolean;

type
  TIOBases = array[1..4] of word;
const
 DefaultIOBase  : TIOBases = ($3F8, $2F8, $3E8, $2E8);

 init:array[1..4] of boolean=(true,true,true,true);

var
  s:TIOBases {$IFNDEF WIN32}absolute $40:0{$ELSE}{ $400}{$ENDIF};
{  t:longint { $IFNDEF WIN32}{absolute $40:$6c}{ $ELSE}{ $46C}{ $ENDIF }
  m:longint;
  f:boolean;
  x,y:byte;
{$IFDEF USETIMEOUT}
  timeout:longint;
{$ENDIF}
{$IFDEF WINDOWS}
   com:PComPort;
{$ENDIF}
begin
  TouchReset:=false;
  spa := 0;
  {$IFDEF WIN32}
  s := DefaultIOBase;
  {$ENDIF}
  if (n < 1) or (n > 4) then begin
    ShowMessage('Nesprávné číslo COM portu: ' + IntToStr(n), smError, 0);
    exit;
  end;
  if (s[n] = 0) then begin
    s[n] := DefaultIOBase[n];
    ShowMessage('V BIOS tabulce není COM port ' + IntToStr(n) + ', opraveno.', smError,0);
  end;
  spa := s[n];
  if init[n] then begin
    {$IFDEF WINDOWS}
    if ComInit(n, com) then begin
      ComSetPropInt(com, cpBreak, 1);
      ComDone(com);{initialize}
    end;
    {$ENDIF}

    portout(spa+3, $83);{set DLAB}
    portout(spa, 1);	{115200 bps}
    portout(spa+1, 0);
    portout(spa+3, 3);	{8dta 1 stp no par}
    portout(spa+1, 0);	{no intr}
    portout(spa+4, 3);	{rts and dtr on}
    init[n]:=false;
  end;

  m:= mstime + 55;
  {$IFDEF USETIMEOUT}
  timeout := mstime + TouchTransferTimeout;
  {$ENDIF}
  repeat
    {$IFDEF USETIMEOUT}
    if mstime > timeout then begin
      SetTimedOut(true);
      exit;
    end;
    {$ENDIF}
  until (portin(spa+5) and $60)=$60;	{await TBE&TSRE comtype}
  while odd(portin(spa+5)) do begin
   {x:=}portin(spa); {flush input}
    {$IFDEF WIN32}
    if mstime > m then
      break;{error???}
    {$ENDIF}
  end;
  m := mstime + 55;
  portout(spa+3,$83);	{set DLAB}
  portout(spa+1, 0);    {disable UART generated interrupts}
  portout(spa, 11);	{10473bps}
  portout(spa+3, 3);	{8dta 1 stp no par}
  portout(spa,$f0);	{send reset pulse}
  repeat
    y:=portin(spa+5);
    f:=odd(y);
  until f or (mstime>m);
  if f then
    x:=portin(spa)
  else
    x:=$f0;
  if (x<>$f0) then begin
    touchreset:=true;
    if ((y and $18)<>0) then begin
      repeat until (portin(spa+5) and $60) = $60;
      repeat f:=odd(portin(spa+5)) until (f or (mstime>m));
      { $HINTS OFF}
      if f then
        {x:=}portin(spa);
      { $HINTS ON}
    end;
  end;
  portout(spa+3, $83);
  portout(spa, 1);
  portout(spa+3,3);
end;


function touchbyte(x:byte):byte;
var {bios}
 {t:longint absolute { $IFDEF WIN32}{ $46c;}{ $ELSE}{ $40:$6c;}{ $ENDIF}
 m:longint;
 i,j:byte;
begin
  if spa=0 then
    touchbyte:=x
  else begin
    m:=mstime+55;
    repeat until (portin(spa+5) and $60)=$60;
    while odd(portin(spa+5)) do begin
      {i:=}portin(spa); {flush input}
      {$IFDEF WIN32}
      if mstime > m then
        break;
      {$ENDIF}
    end;
    i:=0;j:=0;
    repeat
      if odd(portin(spa+5)) then begin
        inc(j);
        if odd(portin(spa)) then
          x := x or $80;
      end else if (i<=j) and ( (portin(spa+5) and $20) = $20 ) then
      begin
       if odd(x) then
         portout(spa, $ff)
       else
         portout(spa, 0);
       x:=x shr 1;inc(i);
      end;
    until (j = 8) or (mstime>m);
    while (j < 8) do begin
      x:=x shr 1 or $80;
      inc(j)
    end;
    touchbyte:=x;
  end;
end;

function GetTouchID(APortNr:integer; var ATouchID:TMediumID):boolean;
var
  rec:byte;
  n:integer;

begin
  GetTouchID:=false;
  {$IFDEF USETIMEOUT}
  TimedOut:= false;
  {$ENDIF}
  if not touchreset(APortNr) then
    exit;
  {rec:=}touchbyte($33);
  for n:=0 to 7 do
    ATouchID[n]:=touchbyte($ff);
  rec:=0;
  for n:=0 to 6 do
    rec:=crc_table[rec xor ATouchID[n]];
  if ATouchID[7]=rec then
    GetTouchID:=true;
end;

{
procedure writehex(b:byte);

begin
  write(hex[b div 16],hex[b mod 16]);
end;
}

function write_scratch(APortNr:integer; m:TScratchPad):boolean;
var n:integer;
{   rec:byte;}
begin
  write_scratch:=false;
  if not touchreset(APortNr) then
    exit;
  {rec:=}touchbyte($cc); {skip ROM}
  {rec:=}touchbyte($f); {write TScratchPad}
  {rec:=}touchbyte(m.ta1);
  {rec:=}touchbyte(m.ta2);
  for n:=0 to m.len-1 do
    {rec:=}touchbyte(m.data[n]);
  write_scratch:=true;
end;


function read_scratch(APortNr:integer; var m:TScratchPad):boolean;
var n:integer;
{    rec:byte;}
begin
  read_scratch:=false;
  if not touchreset(APortNr) then
    exit;
  {rec:=}touchbyte($cc); {skip ROM}
  {rec:=}touchbyte($aa); {read TScratchPad}
  m.ta1:=touchbyte($ff);
  m.ta2:=touchbyte($ff);
  m.es:=touchbyte($ff);
  for n:=0 to m.len-1 do
    m.data[n]:=touchbyte($ff);
  read_scratch:=true;
end;

function compare_scratch(APortNr:integer; var m:TScratchPad):boolean;
var n:integer;
{    rec:byte;}
begin
  compare_scratch:=false;
  if not touchreset(APortNr) then
    exit;
  {rec:=}touchbyte($cc); {skip ROM}
  {rec:=}touchbyte($aa); {read TScratchPad}
  compare_scratch:=true;

  if m.ta1<>touchbyte($ff) then
    compare_scratch:=false;
  if m.ta2<>touchbyte($ff) then
    compare_scratch:=false;
  if m.es<>touchbyte($ff) then
    compare_scratch:=false;
  for n:=0 to m.len-1 do
    if m.data[n]<>touchbyte($ff) then
      compare_scratch:=false;
end;


function copy_scratch(APortNr:integer; m:TScratchPad):boolean;
{var n:integer;
    rec:byte;}
begin
  copy_scratch:=false;
  if not touchreset(APortNr) then
    exit;
  {rec:=}touchbyte($cc); {skip ROM}
  {rec:=}touchbyte($55); {copy TScratchPad}
  {rec:=}touchbyte(m.ta1);
  {rec:=}touchbyte(m.ta2);
  {rec:=}touchbyte(m.es);
  copy_scratch:=true;
end;

function read_ram(APortNr:integer; var m:TScratchPad):boolean;
var n:integer;
{    rec:byte;}
begin
  read_ram:=false;
  if not touchreset(APortNr) then
    exit;
  {rec:=}touchbyte($cc); {skip ROM}
  {rec:=}touchbyte($f0); {read TScratchPad}
  {rec:=}touchbyte(m.ta1);
  {rec:=}touchbyte(m.ta2);
  for n:=0 to m.len-1 do
    m.data[n]:=touchbyte($ff);
  read_ram:=true;
end;

function compare_ram(APortNr:integer; var m:TScratchPad):boolean;
var n:integer;
{    rec:byte;}
begin
  compare_ram:=false;
  if not touchreset(APortNr) then
    exit;
  {rec:=}touchbyte($cc); {skip ROM}
  {rec:=}touchbyte($f0); {read TScratchPad}
  {rec:=}touchbyte(m.ta1);
  {rec:=}touchbyte(m.ta2);
  compare_ram:=true;
  for n:=0 to m.len-1 do
    if m.data[n]<>touchbyte($ff) then
      compare_ram:=false;
end;


function TouchToFile(APortNr:integer; AFileName:string):integer;
var
  m{,n}:integer;
{  ram:TScratchPad;}
  vystup:file;
  res:integer;
  cnt,allcnt:longint;

  block:TCHBlock;{chrntype}
label ex;
begin
{  res := 0;}
  if TransProgBox <> nil then begin
    ProgressBox(TransProgBox, pbTop, '',0,0);
    res := -1;
    goto ex;
  end;
  {$IFDEF USETIMEOUT}
  TimedOut:= false;
  {$ENDIF}
  ProgressBox(TransProgBox, pbShow, 'Přenos dat z čipu do souboru', 0,0);
  cnt :=0;
  allcnt := {chrntype}CHTableSize div CHBlockSize - 1;
  assign(vystup, AFileName{'touchrmr.dta'});
  rewrite(vystup,1);
  res := ioresult;
  if res <> 0 then begin
    goto ex;
  end;

  {writeln('01234567');}
  for m:= 0 to (CHTableSize div CHBlockSize) - 1 do begin
    (*
    ram.ta1 := 0;
    ram.ta2 := m shl 2;
    ram.len := BlockSize;
    repeat
      repeat until read_ram(APortNr, ram);
    until compare_ram(APortNr, ram);
    {write('˛');}
    *)
    if not TouchBlockToBuf(APortNr, m * CHBlockSize, CHBlockSize, block) then begin
      ShowMessage('TouchToFile: Chyba při přenosu bloku ' + IntToStr(m),
        smError, 0);
      res := -1;
      break;
    end;
    blockwrite(vystup, block, CHBlockSize);{chrntype}
    res := ioresult;
    if res <> 0 then begin
      ShowMessage('TouchToFile: Chyba při zápisu do souboru ' + AFileName,
        smError, 0);
      break;
    end;
    inc(cnt);
    ProgressBox(TransProgBox, pbUpdate, '', cnt, allcnt);
  end;
  {writeln;}
  close(vystup);
ex:
  TouchToFile := res;
  ProgressBox(TransProgBox, pbHide, '', 0,0);
end;

function FileToTouch(APortNr:integer; AFileName:string):integer;
var
  m{,n}:integer;
{  ram:TScratchPad;}
  vstup:file;
  res:integer;
  cnt,allcnt:longint;
  block:TCHBlock;

label ex;
begin
  res := 0;
  if TransProgBox <> nil then begin
    ProgressBox(TransProgBox, pbTop, '',0,0);
    res := -1;
    goto ex;
  end;
  {$IFDEF USETIMEOUT}
  TimedOut:= false;
  {$ENDIF}
  if ProgressBox(TransProgBox, pbShow, 'Přenos dat ze souboru do čipu', 0,0) <> 0 then
    goto ex;
  {$I-}
  assign(vstup, AFileName);
  reset(vstup,1);
  res := ioresult;
  if res <> 0 then
    goto ex;
  {writeln('write to tram:');}
  cnt :=0;
  allcnt := CHTableSize  div CHBlockSize - 1;

  for m:=0 to (CHTableSize div CHBlockSize) - 1 do begin
    blockread(vstup, block, CHBlockSize);
    res := ioresult;
    if res <> 0 then begin
      ShowMessage('FileToTouch: Chyba při čtení z ' + AFileName + ' blok ' +
        IntToStr(m), smError, 0);
      break;
    end;
    (*
    repeat
      repeat
        ram.ta1:=(m and $7) shl 5;
        ram.ta2:=(m and $f8) shr 3;
        ram.es:=$1f;
        ram.len:=32;
        repeat
          {$IFDEF USETIMEOUT}
          if TimedOut then
            exit;
          {$ENDIF}
        until write_scratch(APortNr, ram);
        repeat until copy_scratch(APortNr, ram);
      until compare_ram(APortNr, ram);
    until compare_ram(APortNr, ram);
    *)
    if not BufToTouchBlock(APortNr, block, m * CHBlockSize, CHBlockSize) then
    begin
      ShowMessage('FileToTouch: Chyba při zápisu do touch, blok ' +
        IntToStr(m), smError, 0);
      break;
      res := -1;
    end;
    {
    if (m+1) mod 4=0 then
      write('˛');}

    inc(cnt);
    if ProgressBox(TransProgBox, pbUpdate, '', cnt,allcnt) <> 0 then
    begin
      res := -1;
      break;
    end;

  end;
  {writeln;}
  close(vstup);
ex:
  ProgressBox(TransProgBox, pbHide, '', 0,0);
  FileToTouch := res;
end;

function TouchBlockToBuf(APortNr:integer; Start,Size:word; var Buf):boolean;
{procedure read_to_file(from,last:integer);}
const
  TableSize = 8 * 1024;
  BlockSize = $20;
var
  m{,n}:integer;
  ram:TScratchPad;

  bf:array[0..TableSize - 1] of byte absolute Buf;
  ps:word;
{$IFDEF USETIMEOUT}
  timeout:longint;
{$ENDIF}
begin
  TouchBlockToBuf := false;
  {$IFDEF USETIMEOUT}
  TimedOut:= false;
  {$ENDIF}
  if ((Start mod BlockSize) <> 0) or
     ((Size mod BlockSize) <> 0) or
     (longint(Start) + Size > TableSize)
  then begin
    ShowMessage('TouchBlockToBuf: Start, Size must be 32*n, in 0-$2000',smError,0);
    exit;
  end;
  {rewrite(vystup,1);}
  {seek(vystup,from*32);}
  {writeln('reading');}
  {for m:=from to last  do}
  {$IFDEF USETIMEOUT}
  timeout := mstime + {globals}TouchTransferTimeout;
  {$ENDIF}
  ps := 0;
  for m := (Start div BlockSize) to ((Start + Size) div BlockSize) - 1 do
  begin
    ram.ta1:=(m and $7) shl 5;
    ram.ta2:=(m and $f8) shr 3;
    ram.len:= BlockSize;
    repeat
      repeat
       {$IFDEF USETIMEOUT}
        if mstime > timeout then
          SetTimedout(true);
        if TimedOut then
         exit;
       {$ENDIF}
       until read_ram(APortNr, ram);
    until compare_ram(APortNr, ram);
    {if (m+1) mod 4=0 then
      write('˛');
    blockwrite(vystup,ram.data,32);}
    move(ram.data, bf[ps], BlockSize);
    inc(ps, BlockSize);
  end;
  {writeln;
  close(vystup);}
  TouchBlockToBuf := true;
end;

function TouchToTimeTable(APortNr:integer; var T:TChTable):boolean;
var s:word;
begin
  TouchToTimeTable := false;
  s := CHTimeTableSize;
  if T.UpConfig.OverflowCounter = 0 then begin
    s := T.UpConfig.NAP - CHTimeTableOffset;
    if s mod 32 <> 0 then begin
      s := (s div 32) * 32 + 32;
    end;
    if s = 0 then begin
      TouchToTimeTable := true;
      exit;
    end;
  end; {chrntype}
  TouchToTimeTable := TouchBlockToBuf(APortNr, CHTimeTableOffset, s, T.TimeTable);
end;

function BufToTouchBlock(APortNr:integer; var Buf; Start, Size: word): boolean;
{procedure write_from_file(from,last:integer);}
const
  TableSize = $2000;
  BlockSize = $20;
var
  m{,n}:integer;
  ram:TScratchPad;

  bf:array[0..TableSize - 1] of byte absolute Buf;
  ps:word;
  {$IFDEF USETIMEOUT}
  timeout:Longint;
  {$ENDIF}
begin
  {reset(vstup,1);
  seek(vstup,from*32);
  writeln('writing...');
  for m:=from to last do}BufToTouchBlock := false;
  {$IFDEF USETIMEOUT}
  TimedOut:= false;
  timeout := mstime + TouchTransferTimeout;
  {$ENDIF}

  if ((Start mod BlockSize) <> 0) or
     ((Size mod BlockSize) <> 0) or
     (longint(Start) + Size > TableSize)
  then begin
    ShowMessage('BufToTouchBlock: Start, Size must be 32*n, in 0-$2000',smError,0);
    exit;
  end;
  ps := 0;
  for m := (Start div BlockSize) to ((Start + Size) div BlockSize) - 1 do
  begin
    move(bf[ps], ram.data, BlockSize);
    inc(ps, BlockSize);
   {blockread(vstup,ram.data,32);}
    repeat
      repeat
        ram.ta1:=(m and $7) shl 5;
        ram.ta2:=(m and $f8) shr 3;
        ram.es:=$1f;
        ram.len:=32;
        repeat
         {$IFDEF USETIMEOUT}
          if mstime > timeout then
            SetTimedOut(true);
          if TimedOut then
           exit;
         {$ENDIF}
        until write_scratch(APortNr, ram);
        repeat until copy_scratch(APortNr, ram);
      until compare_ram(APortNr, ram);
    until compare_ram(APortNr, ram);
   {if (m+1) mod 4=0 then write('˛');}
   end;
   {writeln;
   close(vstup);}BufToTouchBlock := true;
end;

function TouchTableToTouch(APortNr:integer; ASize:word; var T:TCHTable):boolean;
begin
  TouchTableToTouch := false;
  if (ASize mod CHBlockSize) <> 0 then begin
    ASize := (ASize div CHBlockSize) * CHBlockSize + CHBlockSize;
  end;
  if ASize > 0 then begin
    if not BufToTouchBlock(APortNr, T, 0, ASize) then
      exit;
  end;
  if not BufToTouchBlock(APortNr, T.Data[DownConfigMod32Offset], DownConfigMod32Offset, CHBlockSize) then
    exit;
  if not BufToTouchBlock(APortNr, T.Data[UpConfigMod32Offset], UpConfigMod32Offset, CHBlockSize) then
    exit;
  {chrntype globals}
  TouchTableToTouch := true;
end;

procedure  verify_date(APortNr:integer; var ram:TScratchPad);
begin
 ram.ta1:=lo(old_date);
 ram.ta2:=hi(old_date);
 ram.len:=6;
 repeat
   repeat
    {$IFDEF USETIMEOUT}
     if TimedOut then
      exit;
    {$ENDIF}
   until read_ram(APortNr, ram);
 until compare_ram(APortNr, ram);
end;
(*
procedure read_to_file(from,last:integer);
var m,n:integer;
    ram:TScratchPad;
begin
rewrite(vystup,1);
seek(vystup,from*32);
writeln('reading');
for m:=from to last do
 begin
 ram.ta1:=(m and $7) shl 5;
 ram.ta2:=(m and $f8) shr 3;
 ram.len:=32;
 repeat
 repeat until read_ram(ram);
 until compare_ram(ram);
  if (m+1) mod 4=0 then write('˛');
 blockwrite(vystup,ram.data,32);
 end;
writeln;
close(vystup);
end;




procedure write_from_file(from,last:integer);
var m,n:integer;
    ram:TScratchPad;
begin
reset(vstup,1);
seek(vstup,from*32);
 writeln('writing...');
for m:=from to last do
 begin
 blockread(vstup,ram.data,32);
 repeat
 repeat
 ram.ta1:=(m and $7) shl 5;
 ram.ta2:=(m and $f8) shr 3;
 ram.es:=$1f;
 ram.len:=32;
 repeat until write_scratch(ram);
 repeat until copy_scratch(ram);
 until compare_ram(ram);
 until compare_ram(ram);
 if (m+1) mod 4=0 then write('˛');
 end;
 writeln;
close(vstup);
end;
*)

{$IFNDEF WINDOWS}
function Scan(APortNr:integer):integer;
var
  res:integer;
  ch:char;
  ATouchID:TMediumID;
label ex;
begin
  res := 0;
  repeat
    writeln('TOUCH READER READY:press touch DS1996');
    repeat until GetTouchID(APortNr, ATouchID);
    if not IsMemTouchID(ATouchID) then begin
      writeln('error - not DS1996, press esc to exit');
      ch := readkey;
      if ch = #27 then begin
        res := drInterrupted;
        goto ex;
      end;
    end else
      break;
  until false;

  write('touch ram id=', GetTouchIDStr(ATouchID));
  {for j:=0 to 7 do
   writehex(TouchID[j]);}
  writeln;

  res := TouchToFile(APortNr, 'touchrmr.dta');
  if res <> 0 then
    goto ex;
  res := FileToTouch(APortNr, 'touchrmw.dta');
ex:
  Scan := res;
end;

{$ENDIF}

(*
begin
comm:=2;
repeat
writeln('TOUCH READER READY:press touch DS1996');
repeat until get_id(id_num);
if id_num[0]<>$c then writeln('error - not DS1996');
until id_num[0]=$c;
assign(vystup,'touchrmr.dta');
assign(vstup,'touchrmw.dta');
write('touch ram id=');
for j:=0 to 7 do
 writehex(id_num[j]);
writeln;

if paramstr(1)='i' then
begin
writeln('read');
read_to_file(0,$ff);
writeln('write');
write_from_file(0,$ff);
end
else
begin
verify_date(pom);
if not ((pom.data[4]=0) and (pom.data[5]=0)) then
begin
writeln('read 800-1fff');
read_to_file($800 div $20,($2000 div $20)-1);
writeln('write 0..$7ff');
write_from_file(0 div $20,($800 div $20)-1);
writeln('write 1fe0-1fff');
write_from_file($1fe0 div $20,($2000 div $20)-1);
end
else begin
     write('transfer do dveri nebyl proveden pro OLD DATE= ' );
     writehex(pom.data[0]);
     writehex(pom.data[1]);
     writeln;
     writeln('pokud se jedna o inicializaci spustte s parametrem i');
     end;
end;

end.
*)
end.
