uses dos, graph, crt, wincrt, sysutils;

const
name          = 'RFC 9.1 La / -La + B delay';
sti            : string = 'c:\users\eh\onedrive\m2\';
serial         : shortstring = 'com1';
spsk_max       = 100;
space          : byte = 32;
spsk_change    : boolean = false;
s88_test       : boolean = false;
s88_read       : byte   = 131;
godkendt	= '$%0123456789ABCDEFabcdef';
togvmax		= $ff;
segwrmax	= 20;
spskmax		= 100;
noed_tid	: boolean = false;
osb		: boolean = false;
a1_5            : boolean = false;
magasin         : boolean = false;
ag              : boolean = false;
ymax            = 700;
pixel           : char  = chr(250);
spsk_timer_max  = 600;



type
   tsegment     = record
                  mask:longword;
                  farve,old:byte;
                  xy:array [0..7] of word;
                  end;
   tnoed	= set of byte;

var
   gd,gm : integer;
   PathToDriver : string;
   x,y	: word;
   tx   : text;
   segm : array[0..$ff] of tsegment;
   spsk : array[0..spsk_max ] of record kont, fastl, rl, maga, pa, xa, ya, pair: word; laast: boolean; end;

   s    : string;
   cmd, old_cmd  : shortstring;
   c    : char;
   asx, err, null  : byte;
   tid,gltid: shortstring;
   stjerne      : byte;
   spsk_timer   : word;
   ready, hb6, h6a        : boolean;

   handle       : longint;
   buffer       : array[0..1] of byte;
   s88buffer    : array[0..9] of byte;
   s88          : longword absolute s88buffer;
   s89          : longword absolute s88buffer[4];
   old_s88      : longword;
   old_s89,lw   : longword;


   togveje	: array[0..togvmax] of record
   		mag, hoved  : boolean;
                fast, tid, aspect : byte;
   		navn : shortstring;
                cond : array[0..3] of longword;
                sporsk: array[0..spskmax] of record num, side : byte; end;
                segwy: array[0..segwrmax] of byte;
                segwg: array[0..segwrmax] of byte;
                end;

   as_adr, as_old     : array[0..39] of word;


{$i tal.pp }
{$i m_errmsg.pas }

function henttal(var s:string):longword;
var
  local : shortstring;
  i	: longword;
  e   : word;
begin
i:=0;
local:='';
while (s>'') and (pos(s[1],godkendt)=0) do delete(s,1,1);
while (s>'') and (pos(s[1],godkendt)>0) do
begin
        local:=local+s[1];
        delete(s,1,1);
        end;
val(local,i,e);

henttal:=i;
end;


procedure loadtogv;
const
  weiche : byte = 0;
  segmy  : byte = 0;
  segmg  : byte = 0;

begin
fillchar(togveje,sizeof(togveje),0);
x:=0;
assign(tx,sti+'togveje.txt');
{$i-}
reset(tx);
{$i+}
if boolean(ioresult) then exit;

while not seekeof(tx) do with togveje[x] do
        begin
        while navn='' do readln(tx,navn);
        navn:=upcase(navn);
        if navn[1]='H' then hoved:=true;
        readln(tx,aspect,cond[0],cond[1],cond[2],cond[3]);
        y:=0;
        while not seekeoln(tx) do begin read(tx,sporsk[y].num,sporsk[y].side); inc(y); end;
        readln(tx);
        if y>weiche then weiche:=y;
        y:=0;
        while not seekeoln(tx) do begin read(tx,segwy[y]); inc(y); end;
        readln(tx);
        if y>segmy then segmy:=y;
        y:=0;
        while not seekeoln(tx) do begin read(tx,segwg[y]); inc(y); end;
        if y>segmg then segmg:=y;
        inc(x);
        end;

close(tx);
writeln(x,' togveje med max ',weiche,' sporskifter og ',segmy,' + ',segmg,' segmenter');
end;

procedure writetogv;

var
  p : word;
  b : byte;

procedure wr;
begin
if togveje[p].navn='' then exit;

with togveje[p] do begin
writeln(tx,navn);
writeln(tx,aspect,' $',hex(cond[0],8),' $',hex(cond[1],8),' $',hex(cond[2],8),' $',hex(cond[3],8));
write(tx,sporsk[0].num,' ',sporsk[0].side);
b:=1;
while boolean(sporsk[b].num) and (b<spskmax) do
	begin
	write(tx,' ',sporsk[b].num,' ',sporsk[b].side);
        inc(b);
        end;
writeln(tx);

write(tx,segwy[0]);
b:=1;
while boolean(segwy[b]) and (b<=segwrmax) do
	begin
        write(tx,' ',segwy[b]);
        inc(b);
        end;
writeln(tx);

write(tx,segwg[0]);
b:=1;
while boolean(segwg[b]) and (b<=segwrmax) do
	begin
        write(tx,' ',segwg[b]);
        inc(b);
        end;
writeln(tx,^M^J);

end; { with }
end;

begin
assign(tx,sti+'togveje.bak');
{$i-}
erase(tx);
{$i+}
p:=ioresult;

assign(tx,sti+'togveje.txt');
rename(tx,sti+'togveje.bak');

assign(tx,sti+'togveje.txt');
rewrite(tx);

p:=0;
wr;
togveje[0].navn:=chr($ff);

for x:=1 to togvmax do
	begin
        p:=0;
        for y:=1 to togvmax do if togveje[y].navn<togveje[p].navn then p:=y;

        wr;
        togveje[p].navn:=togveje[0].navn;
        end;

close(tx);
end;



procedure loadseg;
var
  segnr, pos : byte;

procedure checkseg(segnr,x:byte);
begin
if segm[segnr].xy[x]>segm[segnr].xy[x+2] then writeln('Error in segment ',segnr,'  ',x);
end;


begin
fillchar(segm,sizeof(segm),0);
assign(tx,sti+'segment.txt');
{$i-}
reset(tx);
{$i+}
err:=ioresult;
if boolean(err) then exit;
while not seekeof(tx) do
        begin
        pos:=0;
        readln(tx,s);
        segnr:=henttal(s);
        segm[segnr].mask:=henttal(s);
        with segm[segnr] do
        begin
        while s>'' do
                begin
                xy[pos]:=henttal(s);
                inc(pos);
                end;
        end;


        checkseg(segnr,0);
        checkseg(segnr,4);
        end;
close(tx);
end;

procedure loadspskdat;
begin
for x:=0 to spsk_max do spsk[x].kont:=1;

assign(tx,sti+'spsk_dat.txt');
{$i-}
reset(tx);
{$i+}
if boolean(ioresult) then exit;

while not seekeof(tx) do
        begin
        readln(tx,s);
        x:=henttal(s);
        spsk[x].rl:=henttal(s);
        spsk[x].kont:=0;
        spsk[x].laast:=boolean(pos('TRUE',s));
        end;

close(tx);
{ erase(tx);  spsk_dat }
end;

procedure write_spskdat;
begin
if spsk_change then
	begin
        writeln;
        writeln(tid,' Now writing '+sti+'spsk_dat.txt');
        assign(tx,sti+'spsk_dat.txt');
	rewrite(tx);
	for x:=1 to spsk_max do with spsk[x] do if boolean(maga) and (kont=0) then writeln(tx,tal(x,2),^I,rl,^I,laast);
	close(tx);
        end;
spsk_change:=false;
spsk_timer:=0;
end;

procedure programme_end(const x:byte);
begin
   CloseGraph; { restores the old graphics mode }
   fileclose(handle);
   writeln(tid,' Closed serial communication');

   write_spskdat;
   halt(x);

end;

procedure barspsk(nr,farve:byte);
const
        ben=11;
begin
if spsk[nr].xa=0 then exit;
setfillstyle(solidfill,farve);
with spsk[nr] do begin
case pa of
        2,3     : bar(xa-1,ya-ben,xa+ben,ya+1);
        4,5     : bar(xa-1,ya-1,xa+ben,ya+ben);
        6,7     : bar(xa-ben,ya+ben,xa+1,ya-1);
        8,1     : bar(xa-ben,ya-ben,xa+1,ya+1);
        else      bar(xa-ben,ya-ben,xa+ben,ya+ben);
end;   { case  }
end;    { with  }
end;    { proc  }



procedure myline(a,b,c,d:word);

var
  x,y : word;

begin
settextjustify(1,1);

if a>c then
        begin
        x:=a;
        a:=c;
        c:=x;

        x:=b;
        b:=d;
        d:=x;
        end;

if (a=c) or (b=d) then
        begin
        if b>d then
                begin
                x:=b;
                b:=d;
                d:=x;
        end;

        for x:=a to c do for y:=b to d do outtextxy(x,y,pixel)
        end
else
        begin

        if b<d then
                begin
                for x:=a to c do
                        begin
                        outtextxy(x,b,pixel);
                        inc(b);
                        end;
                end
        else
                for x:=a to c do
                        begin
                        outtextxy(x,b,pixel);
                        dec(b);
                        end;

        end; { skraa linie      }

end; { myline }

procedure tegnspsk(nr:byte);
const
        ben=10;
begin
if spsk[nr].xa=0 then exit;
with spsk[nr] do begin
if laast then setcolor(yellow) else setcolor(fastl);
case pa-rl of
        1       : myline(xa,ya,xa,ya-ben);
        2       : myline(xa,ya,xa+ben,ya-ben);
        3       : myline(xa,ya,xa+ben,ya);
        4       : myline(xa,ya,xa+ben,ya+ben);
        5       : myline(xa,ya,xa,ya+ben);
        6       : myline(xa,ya,xa-ben,ya+ben);
        7       : myline(xa,ya,xa-ben,ya);
        8,0     : myline(xa,ya,xa-ben,ya-ben);
end;    { case  }
end;    { with  }
end;    { proc  }

procedure loadspsk;
var
  spsknr : byte;
begin
fillchar(spsk,sizeof(spsk),0);
assign(tx,sti+'spsk.txt');
{$i-}
reset(tx);
{$i+}
err:=ioresult;
if boolean(err) then exit;
while not seekeof(tx) do
        begin
        readln(tx,s);
        spsknr:=henttal(s);
        with spsk[spsknr] do
                begin
                maga:=henttal(s);
                pa:=henttal(s);
                xa:=henttal(s);
                ya:=henttal(s);
                pair:=henttal(s);
                end;
        end;
close(tx);
end;

procedure writebyte(zb:byte);
begin
buffer[0]:=zb;
zb:=filewrite(handle,buffer,1);
end;

function skiftmagnet(nr,side:byte):byte;
var
  z     : byte;
begin
z:=0;
buffer[0]:=33+side;
buffer[1]:=nr;
if filewrite(handle,space,1)<>1 then z:=160;
delay(100);
if filewrite(handle,buffer,2)<>2 then programme_end(160);
delay(300);
if filewrite(handle,space,1)<>1 then z:=160;
delay(100);
if filewrite(handle,buffer,2)<>2 then z:=160;
delay(300);

{ writeln(nr:4,side:4,z:4); }
skiftmagnet:=z;
end;

procedure skiftspor(nr, side:byte);
begin
if (spsk[nr].rl=side) and (spsk[nr].kont=0) then exit;
if (spsk[nr].fastl in [yellow,green]) or spsk[nr].laast then err:=255;
if osb xor (spsk[nr].fastl=magenta) then err:=255;

if boolean(err) then exit;

with spsk[nr] do
begin
kont:=0;
rl:=side;
{if maga=0 then exit;}
barspsk(nr,black);
if boolean(maga) then err:=skiftmagnet(maga,side); {else writeln('Spsk ',nr,' findes ikke');}
if err<>0 then kont:=1 else tegnspsk(nr);
spsk_change:=true;
spsk_timer:=0;
end;
end;

procedure baggrund;
begin
setfillstyle(solidfill,red);
bar(900,30,910,40);
setfillstyle(solidfill,green);
bar(920,30,930,40);
setfillstyle(solidfill,blue);
bar(940,30,950,40);


settextjustify(centertext,toptext);
setcolor(7);
outtextxy(500,10,name);

setcolor(cyan);
settextjustify(centertext,centertext);
outtextxy(906,580,'1');
outtextxy(906,600,'2');
outtextxy(906,620,'3');
outtextxy(906,640,'4');
outtextxy(635,512,'21');
outtextxy(665,512,'20');
outtextxy(560,520,'22');
outtextxy(560,540,'23');
outtextxy(560,560,'24');
outtextxy(560,580,'25');
outtextxy(072,480,'19');
outtextxy(212,480,'18');
outtextxy(072,500,'17');
outtextxy(212,500,'17');
outtextxy(212,520,'16');
outtextxy(212,540,'15');
outtextxy(212,560,'14');
outtextxy(212,580,'13');
outtextxy(212,600,'12');
outtextxy(212,620,'11');
outtextxy(360,650,'F');
outtextxy(960,400,'A');
outtextxy(710,090,'B');
outtextxy(565,090,'C');
outtextxy(565,130,'D');
outtextxy(560,300,'1');
outtextxy(560,320,'2');
outtextxy(560,340,'3');
outtextxy(560,360,'4');
outtextxy(560,380,'5');
outtextxy(805,155,'6');
outtextxy(906,300,'7');
outtextxy(212,100,'1');
outtextxy(212,120,'2');
outtextxy(212,140,'3');
outtextxy(212,160,'4');
outtextxy(212,180,'5');
outtextxy(212,280,'9');
outtextxy(212,260,'8');
outtextxy(212,240,'7');
outtextxy(212,220,'6');
outtextxy(370,230,'20 21 22');

setlinestyle(solidln,0,1);
circle(490,540,20);
putpixel(490,540,cyan);
end;

procedure as_isol;
var
  x : byte;

procedure wr(iso,adr:word);
  const
        x2 = 370;
        x3 = 45;
begin
case iso of
01 : outtextxy(1016,580,tal(adr,2));
02 : outtextxy(1016,600,tal(adr,2));
03 : outtextxy(1016,620,tal(adr,2));
04 : outtextxy(1016,640,tal(adr,2));
05 : outtextxy(212,660,tal(adr,2));
06 : outtextxy(835,155,tal(adr,2));
07 : outtextxy(639,090,tal(adr,2));
21 : outtextxy(x2,300,tal(adr,2));
22 : outtextxy(x2,320,tal(adr,2));
23 : outtextxy(x2,340,tal(adr,2));
24 : outtextxy(x2,360,tal(adr,2));
25 : outtextxy(x2,380,tal(adr,2));
31 : outtextxy(x3,100,tal(adr,2));
32 : outtextxy(x3,120,tal(adr,2));
33 : outtextxy(x3,140,tal(adr,2));
34 : outtextxy(x3,160,tal(adr,2));
35 : outtextxy(x3,180,tal(adr,2));
36 : outtextxy(x3,220,tal(adr,2));
37 : outtextxy(x3,240,tal(adr,2));
38 : outtextxy(x3,260,tal(adr,2));
39 : outtextxy(x3,280,tal(adr,2));
end; { case }
end; { wr }

begin
settextjustify(centertext,centertext);
setcolor(black);
for x:=1 to 39 do if boolean(as_old[x]) then begin wr(x,as_old[x]); as_old[x]:=0; end;
setcolor(white);
for x:=1 to 39 do if boolean(as_adr[x]) then begin wr(x,as_adr[x]); as_old[x]:=as_adr[x]; end;
end;

procedure read_s88;
var zzz : byte;
begin
delay(100);
if filewrite(handle,s88_read,1)<>1 then programme_end(160);
if fileread(handle,s88buffer,6)<>6 then programme_end(161);
{ write(tal(fileread(handle,s88buffer,6),1));                }
{ for zzz:=0 to 7 do write(^I+tal(s88buffer[zzz],3)); writeln; }
end;

procedure oploes1(aspect:byte);
begin
case aspect of
2..4    : skiftmagnet(33,1);
5..6,8	: ;
7	: skiftmagnet(57,1);
9	: skiftmagnet(58,1);  { H F 1..4 }
11,16   : skiftmagnet(101,1); { PU 6 A + H A ?  }
15      : begin skiftmagnet(101,1); { skiftmagnet(54,1);} skiftmagnet(108,1); h6a:=false; oploes1(1)
; end;{ PU 6 A + H A ?  }
12..14  : begin skiftmagnet(106,1); skiftmagnet(54,1); end;     { A u	}
20..26  : skiftmagnet(106,1);		     { A u	}
17   : begin skiftmagnet(108,1); hb6:=false; end; { B }
18   : begin skiftmagnet(52,1); skiftmagnet(108,1); end; { B }
19   : a1_5:=false;
27..29   : skiftmagnet(103,1);{ C & D    }
30,31   : skiftmagnet(103,1);{ C & D    }
end;

if aspect=11 then a1_5:=false;
ready:=false;
end;

procedure oploes2(aspect:byte);
begin
case aspect of
1       : skiftmagnet(49,0); { sbo }
{3	: begin skiftmagnet(33,1); skiftmagnet(59,1); end;
4	: begin skiftmagnet(33,1); skiftmagnet(60,1); end;}
3,5	: skiftmagnet(59,1);
4,6	: skiftmagnet(60,1);
12..14  : begin  skiftmagnet(54,1); skiftmagnet(51,1); skiftmagnet(53,1); end;
15	: begin  skiftmagnet(54,1); skiftmagnet(51,1); end;
16      : skiftmagnet(52,1);
17      : skiftmagnet(51,1);
end;

if aspect in [1,11..14,19..26] then { skiftmagnet (49,1); } { sporisol }
ready:=false;
end;



procedure noedopl(s:tnoed);
begin
for x:=0 to togvmax do with togveje[x] do
	begin
        if aspect in s then
        	begin
                mag:=false;
	        if fast>100 then
        		begin
                	oploes1(aspect);
	                if aspect in [3..6,16,30,31] then oploes2(aspect);
        	        if hoved then fast:=20 else fast:=1;
                        noed_tid:=true;
                        end;
                end;
        end;

if 17 in s then ag:=false;
end;

procedure writemag(mx:boolean);
begin
if mx then setcolor(yellow) else setcolor(black);
settextjustify(lefttext,toptext);
outtextxy(906,512,'M');
end;

function ordre(s:shortstring):byte;
var
  x :byte;
begin
while boolean(pos('  ',s)) do delete(s,pos('  ',s),1);
while (s>'') and (s[length(s)]=' ') do delete(s,length(s),1);
while (s>'') and (s[1]=' ') do delete(s,1,1);
err:=0;
for x:=0 to togvmax do if s=togveje[x].navn then
        begin
        togveje[x].mag:=true;
        writemag(true);
        if (togveje[x].aspect in [11..14,19,24..26]) then a1_5:=true;
        end;
if s='-SBO' then ordre('N 7');
if s='FAT' then begin pixel:=chr(254); ordre('FS'); end;
if s='THIN' then  begin pixel:=chr(250); ordre('FS'); end;
if (s='FS') or (s='TI') then begin clearviewport; baggrund; s88_test:=false; for x:=1 to $ff do segm[x].old:=0; { skiftmagnet (49,1); } end;
if s='LOAD' then begin clearviewport; baggrund; loadseg; write_spskdat; loadspsk; loadspskdat; loadtogv; end;
if s='WRITE' then begin clearviewport; writetogv; loadtogv; baggrund; end;
if s='SEG' then begin setcolor(white); for x:=0 to $ff do if segm[x].xy[0]>0 then outtextxy(segm[x].xy[0],segm[x].xy[1],tal(x,3)); end;
if s='SNR' then begin setcolor(white); for x:=0 to spsk_max do if spsk[x].xa>0 then outtextxy(spsk[x].xa,spsk[x].ya,tal(x,3)); end;
if s='INR' then begin setcolor(white); for x:=0 to $ff do if segm[x].xy[0]>0 then outtextxy(segm[x].xy[0],segm[x].xy[1],tal(x,3)); end;
if (s='NOT') or (s='PAUSE') then
        begin
        null:=ordre('NALT');
        delay(500);
        writebyte(97);
        clearviewport;
        write_spskdat;
        null:=byte(readkey);
        writebyte(96);
        delay(1000);
        baggrund;
        null:=ordre('TI');
        end;

if copy(s,1,2)='O ' then
        begin
        x:=henttal(s);
        if x>spskmax then
                begin
                err:=201;
                end
        else
                begin
        skiftspor(x,spsk[x].rl xor 1);
        if boolean(spsk[x].pair) then skiftspor(spsk[x].pair,spsk[x].rl);
        { pair }
        end;    { else  }
        end;

if copy(s,1,3)='LA ' then
        begin
        s:=copy(s,4,$ff);
        x:=henttal(s);
        if x>spskmax then
                begin
                err:=201;
                end
        else
                begin
        spsk[x].laast:=true;
        tegnspsk(x);
        if boolean(spsk[x].pair) then
                begin
                spsk[spsk[x].pair].laast:=true;
                tegnspsk(spsk[x].pair);
                end;
        { pair }
        spsk_change:=true;
        end;    { else }
        end;

if copy(s,1,4)='-LA ' then
        begin
        s:=copy(s,4,$ff);
        x:=henttal(s);
        if x>spskmax then
                begin
                err:=201;
                end
        else
                begin
        spsk[x].laast:=false;
        tegnspsk(x);
        if boolean(spsk[x].pair) then
                begin
                spsk[spsk[x].pair].laast:=false;
                tegnspsk(spsk[x].pair);
                end;
        { pair }
        spsk_change:=true;
        end;    { else  }
        end;

if copy(s,1,4)='TIN ' then begin x:=henttal(s); if x>39 then x:=0; as_adr[x]:=henttal(s); if as_adr[x]>39 then as_adr[x]:=0; end;

if copy(s,1,4)='TSL ' then begin as_adr[henttal(s)]:=0; end;
if copy(s,1,4)='OSB ' then begin  osb:=true; delete(s,2,2); null:=ordre(s); osb:=false; end;
if copy(s,1,4)='TEST' then
        begin
        delete(s,1,5);
        x:=henttal(s);
        for y:=0 to 9 do
                begin
                skiftmagnet(x,0);
                delay(500);
                skiftmagnet(x,1);
                end;
        end;

if (copy(s,1,2)='S ') or (copy(s,1,2)='N ') then
	case s[3] of
        '1'	: noedopl([2,10]);
        'F'	: noedopl([3,4,5,6,7,8,9]);
        'A'	: begin noedopl([11..16,17,19,24,25,26]); a1_5:=false; end;
        'B'	: noedopl([16,17,18]);
        '7'	: noedopl([1,20..23,32]);
        'C','D' : noedopl([27..31]);
        else	writeln(tid,' Error in S ',s[3]);
        end;


if s='STARTO' then
        begin
        null:=ordre('nalt');
        for x:=0 to spsk_max do {if boolean(spsk[x].maga) then
	begin }
        spsk[x].kont:=1;
        { skiftspor(x,spsk[x].rl); }
        null:=ordre('TI');
        end;

if s='S88' then s88_test:=true;

if s='NALT' then
        begin
        for x:=1 to togvmax do with togveje[x] do
	begin
        if fast>100 then
        	begin
                oploes1(aspect);
                if aspect in [3..6] then oploes2(aspect);
                if hoved then fast:=20 else fast:=1;
                end;
        mag:=false;
        end;
        end;

if s='SMAG' then for x:=1 to togvmax do togveje[x].mag:=false;

if copy(s,1,3)='HEX' then
        begin
        s:=copy(s,4,$ff);
        old_cmd:='$'+hex(henttal(s),4);
        end;

if s='H A B' then
        begin
        null:=ordre('H A 6');
        null:=ordre('H 6 B');
        end;

if s='H B A' then
        begin
        null:=ordre('H B 6');
        null:=ordre('H 6 A');
        end;


if s='AG' then ag:=true;
if s='-AG' then ag:=false;

end;


function testtogvej(x:word):byte;
var y : byte;
begin
with togveje[x] do
	begin
        if (s88 and cond[0])>0 then
        	begin
                testtogvej:=1;
                exit;
                end;

        end;
testtogvej:=0;
end;

procedure ag_a;
begin
if ag and (not a1_5) then null:=ordre('H A 6');
end;


function set_togvej(x:byte):byte;
begin
        with togveje[x] do begin
        err:=0;
        if (s88 and cond[0])>0 then err:=254;
        for y:=0 to spskmax do if (err=0) and boolean(sporsk[y].num)
        and (sporsk[y].side<4) then skiftspor(sporsk[y].num,sporsk[y].side and 1);
        if ready and (err=0) then
        	begin
                ready:=false;
                case aspect of
                1       : skiftmagnet(49,1); { sbo       }

                2	: skiftmagnet(34,0);
                3	: begin skiftmagnet(59,0); skiftmagnet(34,0); end;
                4       : begin skiftmagnet(60,0); skiftmagnet(33,0); ag_a; as_adr[5]:=as_adr[1]; as_adr[1]:=0; end;
                5	: skiftmagnet(59,0);
                6	: begin skiftmagnet(60,0); ag_a;
                                case togveje[x].navn[3] of
                                '2'     : begin as_adr[5]:=as_adr[2]; as_adr[2]:=0; end;
                                '3'     : begin as_adr[5]:=as_adr[3]; as_adr[3]:=0; end;
                                '4'     : begin as_adr[5]:=as_adr[4]; as_adr[4]:=0; end;
                                end; { case }
                                end; { h 2..4 f }
                7	: skiftmagnet(57,0);
                8	: as_adr[5]:=0;
                9	: begin skiftmagnet(58,0); as_adr[5]:=0; end;
                11      : begin skiftmagnet(50,1); skiftmagnet(102,1); { skiftmagnet (49,0); } as_adr[5]:=0; end;
                12      : begin skiftmagnet(53,0); skiftmagnet(51,0); skiftmagnet(54,0); skiftmagnet(56,0); skiftmagnet(106,0); { skiftmagnet (49,0); } as_adr[5]:=as_adr[21]; as_adr[21]:=0; end;{ h 1 A    }
                13      : begin skiftmagnet(53,0); skiftmagnet(51,0); skiftmagnet(54,0); skiftmagnet(56,1); skiftmagnet(55,0); skiftmagnet(106,0); { skiftmagnet (49,0); } as_adr[5]:=as_adr[22]; as_adr[22]:=0; end;{ h 2 A }
                14      : begin skiftmagnet(53,0); skiftmagnet(51,0); skiftmagnet(54,0);  skiftmagnet(56,1); skiftmagnet(55,1); skiftmagnet(106,0); { skiftmagnet (49,0); }
                                case togveje[x].navn[3] of
                                '3'     : begin as_adr[5]:=as_adr[23]; as_adr[23]:=0; end;
                                '4'     : begin as_adr[5]:=as_adr[24]; as_adr[24]:=0; end;
                                '5'     : begin as_adr[5]:=as_adr[25]; as_adr[25]:=0; end;
                                end; { case }
                                end;{ h 3..5 A	}
                15      : begin skiftmagnet(51,0); skiftmagnet(54,0); skiftmagnet(101,0); as_adr[5]:=as_adr[6]; as_adr[6]:=0; h6a:=true; if hb6 then skiftmagnet(107,1); end ;{ h 6 A	}
                16      : begin skiftmagnet(52,0); skiftmagnet(50,0); skiftmagnet(102,1); if ag then ordre('H 6 B'); as_adr[6]:=as_adr[5]; as_adr[5]:=0; end;
                17      : begin skiftmagnet(51,0); skiftmagnet(107,0); if ag then ordre('H 6 A'); as_adr[6]:=as_adr[7]; as_adr[7]:=0; hb6:=true; if h6a then skiftmagnet(107,1); end; { h b 6 }
                18      : begin skiftmagnet(108,0); as_adr[7]:=as_adr[6]; as_adr[6]:=0; end; { h 6 b }
                19      : as_adr[5]:=0; { R A 1..6 }
                20,24   : begin skiftmagnet(56,0); skiftmagnet(106,0); { skiftmagnet (49,0); } end;{ r 1 a/7         }
                21,25   : begin skiftmagnet(56,1); skiftmagnet(55,0); skiftmagnet(106,0); { skiftmagnet (49,0); } end;{ r 2 A/7}
                22,26   : begin skiftmagnet(56,1); skiftmagnet(55,1); skiftmagnet(106,0); { skiftmagnet (49,0); } end;{ r 3..5 A/7}
                23      : ; { skiftmagnet (49,0); }
                27      : begin skiftmagnet(104,1); as_adr[7]:=0; end;
                28      : as_adr[7]:=0;
                29      : skiftmagnet(102,0);
                30      : begin skiftmagnet(103,0); if ag then ordre('H B 6');
                                case togveje[x].navn[3] of
                                '1'     : begin as_adr[7]:=as_adr[31]; as_adr[31]:=0; end;
                                '2'     : begin as_adr[7]:=as_adr[32]; as_adr[32]:=0; end;
                                '3'     : begin as_adr[7]:=as_adr[33]; as_adr[33]:=0; end;
                                '4'     : begin as_adr[7]:=as_adr[34]; as_adr[34]:=0; end;
                                '5'     : begin as_adr[7]:=as_adr[35]; as_adr[35]:=0; end;
                                '6'     : begin as_adr[7]:=as_adr[36]; as_adr[36]:=0; end;
                                '7'     : begin as_adr[7]:=as_adr[37]; as_adr[37]:=0; end;
                                '8'     : begin as_adr[7]:=as_adr[38]; as_adr[38]:=0; end;
                                '9'     : begin as_adr[7]:=as_adr[39]; as_adr[39]:=0; end;
                                end; { case }
                                end; { 30 }
                31      : skiftmagnet(104,0);
                end;
                fast:=$ff;
                mag:=false;

                for y:=0 to spskmax do if boolean(sporsk[y].num) then
                  begin
                  if sporsk[y].side=4 then
                                        spsk[sporsk[y].num].fastl:=magenta
                                      else
                                        spsk[sporsk[y].num].fastl:=yellow;
                  end;
                end;
                end; { mag      }
set_togvej:=err;
end;

function as_ordre(s:shortstring):byte;
begin
for x:=0 to togvmax do if s=togveje[x].navn then
        begin
        as_ordre:=set_togvej(x);
{        writemag(true);
        if (togveje[x].aspect in [11..14,19,24..26]) then a1_5:=true; }
        end;

end;



begin   { ========================= MAIN =========================== }
clrscr;
writeln(name);

if getenv('marklin')>'' then
        begin
        serial:=(getenv('marklin'));
        writeln('Enviroment variable found, serial set to: ',serial);
        end;
handle:=fileopen(serial,fmopenreadwrite);
if handle=-1 then
        begin
        writeln('Failed to open serial communication');
        halt(160);
        end;


writebyte(96);

{gotoxy(1,10);
for null:=32 to 255 do write(chr(null)+' ');}
getdir(0,sti); sti:=sti+'\'; writeln(sti);


delay(1000);

{c:=char(192);
writeln('Write ',filewrite(handle,c,1));
delay(1000);
c:=char(193);
writeln('Write ',filewrite(handle,c,1));
writeln('Read  ',fileread(handle,s88buffer,1));
}

loadseg;
loadspsk;
loadspskdat;
loadtogv;


   gd:=detect;  { highest possible resolution }
   gm:=0;       {not needed, auto detection   }
   PathToDriver:='c:\pascal\fpc'; { path to BGI fonts
                                drivers aren't needed }
   InitGraph(gd,gm,PathToDriver);
   if GraphResult<>grok then
        begin
        writeln('Graph failed');
        halt(1);
        end;

baggrund;
setcolor(red);
for x:=0 to $ff do if segm[x].xy[0]<>0 then
                with segm[x] do begin
                myline(xy[2],xy[3],xy[0],xy[1]);
                if xy[4]>0 then  myline(xy[4],xy[5],xy[6],xy[7]);
                old:=red;
                delay(10);
                end;

delay(5000);

clrscr;
{gotoxy((80-length(name)) shr 1,1);}
textcolor(white);
writeln(name+^M^J);

repeat  { ===================== LOOP =============================== }


err:=0;
ready:=true;
read_s88;

if err=0 then
begin
settextjustify(lefttext,toptext);
if boolean(stjerne) then setcolor(red) else setcolor(black);
stjerne:=stjerne xor 1;
skiftmagnet(105,stjerne);
outtextxy(20,10,'*');

{gotoxy(1,1);
if boolean(stjerne) then textcolor(8+red) else textcolor(black);
write('*');  }
end
else
write(^G);



{ tid:=datetimetostr(now); }
tid:=formatdatetime('dd mm yyyy hh:nn',now);
if tid<>gltid then
        begin
        setfillstyle(solidfill,black);
        bar(850,10,getmaxx-1,18);
        setcolor(brown);
        outtextxy(850,10,tid);

{        gotoxy(65,1);
        textcolor(brown);
        write(tid);   }
        gltid:=tid;
        end;

textcolor(white);
{ gotoxy(1,24); }

inc(spsk_timer);
if spsk_timer>spsk_timer_max then write_spskdat;


if noed_tid then setcolor(magenta) else setcolor(black);
outtextxy(800,512,'N');

for x:=0 to togvmax do if togveje[x].mag then magasin:=true;
writemag(magasin);
magasin:=false;

if ag then setcolor(brown) else setcolor(black);
outtextxy(906,210,'AG');

for x:=0 to $ff do segm[x].farve:=cyan;
for x:=0 to spsk_max do spsk[x].fastl:=cyan;

for x:=1 to togvmax do with togveje[x] do
	begin
	if mag then for y:=0 to segwrmax do if hoved then
        	begin
        	if boolean(segwg[y]) then segm[segwg[y]].farve:=yellow;
                end
                else
                if boolean(segwy[y]) then segm[segwy[y]].farve:=yellow
        end;

for x:=0 to togvmax do with togveje[x] do
	begin
        if boolean(fast) then
              begin
              for y:=0 to segwrmax do if (boolean(segwy[y])) and (segm[segwy[y]].farve<>green) then segm[segwy[y]].farve:=yellow;
              for y:=0 to segwrmax do if boolean(segwg[y]) then segm[segwg[y]].farve:=green;

              for y:=0 to spskmax do if boolean(sporsk[y].num) then
                	begin
                        case sporsk[y].side of
                        2,3	: spsk[sporsk[y].num].fastl:=green;
                        4	: spsk[sporsk[y].num].fastl:=magenta;
                        else	  spsk[sporsk[y].num].fastl:=yellow;
                        end;
                        end;


	      if fast=1 then
              		begin
                        noed_tid:=false;
                        oploes2(aspect);
                        end;
              if fast<=100 then dec(fast);
              if (fast=$ff) and ((s88 and cond[1])>0) then
              		begin
                        oploes1(togveje[x].aspect);
                        togveje[x].fast:=254;
                        end;
              if (fast=254) and (s88 and cond[2]=cond[3]) then
                        case aspect of
                        16,32   : fast:=3;
                        17      : fast:=12;
                        else      fast:=1;
                        end;
       	      end;

        end;

for x:=0 to togvmax do with togveje[x] do if (mag and (fast=0)) then null:=set_togvej(x);


for x:=0 to $ff do if segm[x].xy[0]>0 then
                with segm[x] do begin
                if (mask and s88)>0 then farve:=red;
                if farve<>old then
                        begin
                        setcolor(farve);
                        myline(xy[0],xy[1],xy[2],xy[3]);
                        if xy[4]>0 then myline(xy[4],xy[5],xy[6],xy[7]);
                        old:=farve;
                        end;
                end;


for x:=1 to spsk_max do if boolean(spsk[x].kont) then barspsk(x,cyan) else tegnspsk(x);

if s88_test and ( s88<>old_s88) then
        begin
        setcolor(white);
        lw:=abs(s88-old_s88);
        outtextxy(20,ymax-10,'$'+hex(lw,8));
        old_s88:=s88;
        end;



if s89<>old_s89 then
begin
if  s88_test then
        begin
        {setfillstyle(solidfill,blue);
        bar(19,ymax-15,400,ymax);}
        setcolor(white);
        writeln{outtextxy}(20,ymax-10,'$'+hex(s89,8)+'      '+'$'+hex(old_s89,8)+'      '+bit(s89,32));
        write(^G);
        end;

if s89>0 then sound(1600);{ else nosound;}


case s89 of
        $20 : null:=ordre('O 16');
        $80 : null:=ordre('O 17');
        $40 : null:=ordre('O 19');
        $10 : null:=ordre('O 18');
        $4000:null:=ordre('O 20');
        $100: null:=ordre('OSB 22');
        $2000:null:=ordre('OSB 23');
        $1000:null:=ordre('OSB 24');
        $0008:null:=ordre('OSB 25');
        $8000:null:=ordre('O 26');
        $400: null:=ordre('O 27');
        $800: null:=ordre('O 28');
        $200: null:=ordre('O 29');
        $0001:null:=ordre('O 50');
        $0002:null:=ordre('O 51');
        $0004:null:=ordre('O 48');
        end; { cse }

old_s89:=s89;
end;

{ AS drift }

for asx:=1 to 39 do if boolean(as_adr[asx]) then
        begin
        case asx of
        1 :  null:=as_ordre('H 1 F');
        2 :  null:=as_ordre('H 2 F');
        3 :  null:=as_ordre('H 3 F');
        4 :  null:=as_ordre('H 4 F');
        5 :  case as_adr[asx] of
                 1,11 :  null:=as_ordre('H F 1');
                 2,12 :  null:=as_ordre('H F 2');
                 3,13 :  null:=as_ordre('H F 3');
                 4,14 :  null:=as_ordre('H F 4');
                 21:  null:=as_ordre('H A 1');
                 22:  null:=as_ordre('H A 2');
                 23:  null:=as_ordre('H A 3');
                 24:  null:=as_ordre('R A 4');
                 25:  null:=as_ordre('H A 5');
                 28:  null:=as_ordre('H A 3.');
                 29:  null:=as_ordre('H A 1.');
                 6,7,31..39 :  null:=as_ordre('H A 6');
                 else as_adr[5]:=0;

                 end;
        6:  case as_adr[asx] of
                 1..5   :  null:=as_ordre('H 6 A');
                 11..15   :  if s88 and $00004000>0 then null:=as_ordre('H 6 A');
                 7,31..39 :  null:=as_ordre('H 6 B');
                 else  begin writeln('Error in adr 6 = ',as_adr[6],^G); as_adr[6]:=0; end;
                 end;
        7:  case as_adr[asx] of
                 1..15 :  if not a1_5 then null:=as_ordre('H B 6');
                 31     :  null:=as_ordre('H C 1');
                 32     :  null:=as_ordre('H C 2');
                 33     :  null:=as_ordre('H C 3');
                 34     :  null:=as_ordre('H C 4');
                 35     :  null:=as_ordre('H C 5');
                 36     :  null:=as_ordre('H C 6');
                 37     :  null:=as_ordre('H C 7');
                 38     :  null:=as_ordre('H C 8');
                 39     :  null:=as_ordre('H C 9');
                 else begin
                 writeln('Error in adr 7 = ',as_adr[7],^G); as_adr[7]:=0; end;
                 end;
        21 :  null:=as_ordre('H 1 A');
        22 :  null:=as_ordre('H 2 A');
        23 :  null:=as_ordre('H 3 A');
        24 :  null:=as_ordre('H 4 A');
        25 :  null:=as_ordre('H 5 A');
        31 :  null:=as_ordre('H 1 C');
        32 :  null:=as_ordre('H 2 C');
        33 :  null:=as_ordre('H 3 C');
        34 :  null:=as_ordre('H 4 C');
        35 :  null:=as_ordre('H 5 C');
        36 :  null:=as_ordre('H 6 C');
        37 :  null:=as_ordre('H 7 C');
        38 :  null:=as_ordre('H 8 C');
        39 :  null:=as_ordre('H 9 C');


        else as_adr[asx]:=0;
        end; { case }
        end;

as_isol;

if keypressed then
        begin
        repeat
        c:=upcase(readkey);
        case c of
        ^@		: case readkey of
		                'P','H' : cmd:=old_cmd;
                		else      write(^G);
		                end;

        ^[		: cmd:='';
        ' '..'Z'        : cmd:=cmd+c;
        ^H              : delete(cmd,length(cmd),1);
        ^M              : begin
		          old_cmd:=cmd;
                          err:=0;
                          ordre(cmd);
                          writeln(tid,'    ',cmd,'    ',errmsg(err));

                          cmd:='';
                          end;
        else              write(^G);
        end;
        until not keypressed;

        setfillstyle(solidfill,black);
        { if c in [^M,^[] then bar(1,ymax-35,getmaxx-1,ymax-26);  error
        bar(1,ymax-25,getmaxx-1,ymax-1);}
        if c in [^H,^M,^[] then bar(1,ymax-35,getmaxx-1,ymax-1);
        setcolor(7);
        settextjustify(lefttext,bottomtext);
        outtextxy(10,ymax-25,errmsg(err));
        outtextxy(10,ymax-15,cmd);
{        gotoxy(1,21); write(cmd+'*'); clreol;  tesktsk‘rm      }
        end;

until c in ['Q',^C];

null:=ordre('NALT');
delay(100);
writebyte(97);
clrscr;
programme_end(0);
end.

