unit temp;
interface
{supported only for xilinx version>=1.4}
uses format,time,definit;
type name=array[0..7]of byte;
     tnames=^names;
     names=record id:name;next:tnames;end;

type lname=string[16];

const noname:name=(0,0,0,0,0,0,0,0);
const mul=9; {to make a fine tuning on the timing}
      
function get_real_name:lname;
function get_name:longint;
function ver_temp:real;
function  temp_get(x:name):real;
procedure temp_search(var t:tnames);
procedure lasered_rom(var sonde:name);
procedure temp_w1(dat:boolean);
function temp_r1:boolean;
function eq(x1,x2:name):boolean;
function  temp_read_temp:real;
function  temp_init:boolean;
procedure temp_write(x:byte);
function temp_read:byte;
procedure temp_skip_rom;
procedure temp_convert;
procedure temp_match_rom(var x:name);
function temp_power:boolean;
function temp_read_rom(var x:name):boolean;
procedure crc(var old:byte;x:byte);
procedure pull_up;
procedure pull_down;

implementation
const c_read_rom=$33;
      c_match_rom=$55;
      c_skip_rom=$cc;
      c_search_rom=$f0;
      c_alarm_search=$ec;
      c_write_scr=$4e;
      c_read_scr=$be;
      c_copy_scr=$48;
      c_convert=$44;
      c_recall=$b8;
      c_pw_sup=$b4;
var
      bit_dat,
      bit_power,
      bit_tri:word;
      mask:word;
      nloop:word;

var temp_base:word;

function eq(x1,x2:name):boolean;
var ok:boolean;
    i:integer;
begin
 ok:=true;
 for i:=1 to 8 do ok:=ok and (x1[i]=x2[i]);
 eq:=ok;
end;

procedure pull_up;
begin
 portw[temp_base]:=bit_power;
 wait;
end;

procedure pull_down;
begin
 portw[temp_base]:=mask;
 wait;
end;

function temp_get(x:name):real;
begin
 temp_get:=-999;
 if temp_init then begin
  if eq(x,noname) then
   temp_skip_rom
  else
   temp_match_rom(x);
  temp_convert;
  if temp_init then begin
   if eq(x,noname) then
    temp_skip_rom
   else
    temp_match_rom(x);
   temp_get:=temp_read_temp;
  end;
 end;
end;

function temp_init:boolean;
{reset pulse: min. 480us, max. 960us}
{then wait delay of 15 to 60 us}
{then the DS1820 yields a presence pulse from 60 to 240us}
const
m1=mul*50;{600}
m2=mul*6;{70}
m3=mul*35;{400}
var
i:integer;
begin
 portw[temp_base]:=mask;
 wait;wait; {wait;}
 portw[temp_base]:=bit_tri;
 for i:=1 to m1 do wait;
 portw[temp_base]:=mask;
 for i:=1 to m2 do wait;
 temp_init:=(portw[temp_base] and bit_dat)=0;
 for i:=1 to m3 do wait;
end;

procedure temp_w1(dat:boolean);
const
m1=mul*9;
m2=2;
{logical zero: 60 to 120 us}
{logical one:}
{between two writing: min. 1us}
var i:integer;
begin
 if not dat then begin
  portw[temp_base]:=bit_tri;
  for i:=1 to m1 do wait;
  portw[temp_base]:=mask;
  wait;wait;
 end
 else begin
  portw[temp_base]:=bit_tri;
  for i:=1 to m2 do wait;
  portw[temp_base]:=mask;
  for i:=1 to m1 do wait;
 end;
end;

function temp_r1:boolean;
const m1=mul*11;
var i:word;
begin
 portw[temp_base]:=bit_tri;
 wait;
 portw[temp_base]:=mask;
 portw[temp_base]:=mask;
 i:=portw[temp_base];
 temp_r1:=(i and $100)<>0;
 portw[temp_base]:=mask;
 for i:=1 to m1 do wait;
end;

procedure temp_write(x:byte);
var i:integer;
begin
 for i:=1 to 8 do begin
  temp_w1((x and 1)<>0);
  x:=x shr 1;
 end;
end;

function temp_read:byte;
var i,j:word;
begin
 j:=0;
 for i:=0 to 7 do
  if temp_r1 then j:=j or (1 shl i);
 temp_read:=j;
end;

procedure temp_skip_rom;
begin
 temp_write(c_skip_rom);
end;

procedure temp_convert;
var i:integer;
begin
 temp_write(c_convert);
 pull_up;
 i:=0;
 repeat
  wait_mili(20);
  i:=i+1;
  if i>100 then begin
   writeln('temperature convertion failed');
   halt;
  end;
 until temp_r1;
 pull_down;
end;



function temp_power:boolean;
begin
 temp_write(c_pw_sup);
 temp_power:=temp_r1;
end;

procedure crc(var old:byte;x:byte);

 function bb(var b:byte;i:integer):boolean;
 begin   {convert bit #i of byte b to boolean}
     bb:=(b and (1 shl i))<>0;
 end;
var c:byte;
    a:boolean;
    i,l:integer;
begin
  for i:=0 to 7 do begin
    a:=x and (1 shl i)<>0;
    c:=0;
    if bb(old,0) xor a then c:=$80;
    for l:=7 downto 5 do if bb(old,l) then c:=c or (1 shl (l-1));
    for l:=4 downto 3 do if bb(old,0) xor a xor bb(old,l) then c:=c or (1 shl (l-1));
    for l:=2 downto 1 do if bb(old,l) then c:=c or (1 shl (l-1));
    old:=c;
  end;
end;

procedure temp_match_rom(var x:name);
var i:integer;
begin
 temp_write(c_match_rom);
 for i:=0 to 7 do temp_write(x[i]);
end;


function temp_read_rom(var x:name):boolean;
var i:integer;
    old:byte;
begin
 old:=0;
 temp_write(c_read_rom);
 for i:=1 to 7 do begin
  x[i]:=temp_read;
  crc(old,x[i]);
 end;
 temp_read_rom:=old=temp_read;
 writeln('crc = ',hex(old,2));
end;

function temp_read_temp:real;
var a,b,c,d,e:byte;
    x:real;
    i:integer;
    old:byte;
begin
 old:=0;
 temp_write(c_read_scr);
 a:=temp_read;
 crc(old,a);
 b:=temp_read;
 crc(old,b);
 for i:=2 to 7 do begin
  c:=temp_read;
  if i=5 then writeln;
  if i=6 then d:=c; { count remain }
  if i=7 then e:=c; { count per oC}
  crc(old,c);
 end;
 if (old=temp_read) and (e<>0) then begin
  a:=a shr 1;
  x:=a - 0.25 + (e-d)/e;
  temp_read_temp:=x;
 end
 else
  temp_read_temp:=-999;
 if temp_init then;
end;

function debut(t:tnames;j:integer;x:name):boolean;forward;


function fini(t:tnames;i:integer;x:name):boolean;
var k,l:integer;
    a,b:boolean;
    ok:boolean;
begin
 fini:=true;
 repeat
  i:=i+1;
  k:=i div 8;
  l:=i mod 8;
  a:=temp_r1;
  b:=temp_r1;
  if a and b then begin
   fini:=false;
   exit;
  end;
  if a<>b then begin
   if a then
    x[k]:=x[k] or (1 shl l);
   temp_w1(a);
  end;
 until (i=63) or (a=b);
 if (a=b) and (i<>63) then begin
  temp_w1(false);
  if not fini(t,i,x) then begin
   fini:=false;
   exit;
  end;
  x[k]:=x[k] or (1 shl l);
  fini:=debut(t,i,x);
 end
 else begin
  while t^.next<>nil do t:=t^.next;
  new(t^.next);
  t^.next^.id:=x;
  t^.next^.next:=nil;
 end;
end;


function debut;
var i,k,l:integer;
    a,b:boolean;
begin
  if j<0 then
   nloop:=0
  else nloop:=nloop+1;
  if nloop>500 then exit; {safeguard}
  if temp_init then
   temp_write(c_search_rom)
  else begin
   writeln('fatal in search');
   halt;
  end;
  for i:=0 to j do begin
   k:=i div 8;
   l:=i mod 8;
   a:=temp_r1;
   b:=temp_r1;
   if a and b then begin
    debut:=false;
    exit;
   end;
   a:=(x[k] and (1 shl l))<>0;
   temp_w1(a);
  end;
  debut:=fini(t,j,x);
end;

procedure lasered_rom(var sonde:name);
var i:integer;
   cr:byte;
begin
  if temp_init then
               temp_write(c_read_rom);
  cr:=0;
  for i:=0 to 6 do begin
               sonde[i]:=temp_read;
               crc(cr,sonde[i]);
  end;
  sonde[7]:=temp_read;
  if cr<>sonde[7] then begin
                  writeln('bad CRC of lasered ROM');
                  halt;
  end;
end;

procedure temp_search(var t:tnames);
var x:name;
    i:integer;
    old:tnames;
begin
 for i:=0 to 7 do x[i]:=0;
 new(old);
 for i:=0 to 7 do old^.id[i]:=255;
 old^.next:=nil;
 if debut(old,-1,x) then
  t:=old^.next
 else
  t:=nil;
 dispose(old);
end;

function ver_temp:real;
begin
 ver_temp:=1.0;
end;


function get_real_name:lname;
var
    i:integer;
    t:tnames;
    ss:lname;
begin
 ss:='';
 if temp_init then;
 if temp_init then begin
  temp_search(t);
  if t<>nil then begin
   for i:=7 downto 0 do ss:=ss+hex(t^.id[i],2);
   if t^.next<>nil then
    ss:='';
  end;
 end;
 if ss='' then
  get_real_name:='unknown'
 else
  get_real_name:=ss;
end;

function get_name:longint;
var
    i:integer;
    t:tnames;
    x:longint;
begin
 x:=0;
 if temp_init then;
 if temp_init then begin
  temp_search(t);
  if t<>nil then begin
   for i:=3 downto 0 do x:=x*256+t^.id[i];
   if t^.next<>nil then
    x:=0;
  end;
 end;
 get_name:=x;
end;



begin
 temp_base:=base+$c;
 mask:=$8000;
 if not space then
  mask:=mask or $1000;
 bit_tri:=$100 or mask;
 bit_power:=$200 or mask;
 bit_dat:=$100;
end.