uses dos, graph, wincrt, sysutils;

const
name          = 'RFC 4.2 ny grafik';
sti            = '\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		= 22;
noed_tid	: boolean = false;
osb		: boolean = false;
a1_5            : boolean = false;
magasin         : boolean = false;
ag              : boolean = true;
ymax            = 700;
pixel           : char  = chr(250);



type
   tsegment     = record
                  mask:longint;
                  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: word; end;

   s    : string;
   cmd, old_cmd  : shortstring;
   c    : char;
   err, null  : byte;
   tid,gltid: shortstring;
   stjerne      : byte;
   ready        : 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;

{$i tal.pp }
{$i m_errmsg.pas }

function henttal(var s:string):longint;
var
  local : shortstring;
  i	: longint;
  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,^I,'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);
       { writeln(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;
        end;

close(tx);
end;

procedure write_spskdat;
begin
if spsk_change then
	begin
        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);
	close(tx);
        end;
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
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);
                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);

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] 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);
err:=skiftmagnet(maga,side);
if err<>0 then kont:=1 else tegnspsk(nr);
spsk_change:=true;
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(410,230,'20 21 22');

setlinestyle(solidln,0,1);
circle(490,540,20);
putpixel(490,540,cyan);
end;

procedure read_s88;
begin
delay(100);
if filewrite(handle,s88_read,1)<>1 then programme_end(160);
if fileread(handle,s88buffer,6)<>6 then programme_end(161);
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,15,16: skiftmagnet(101,1); { PU 6 A + H A ?  }
12..14,20..26  : skiftmagnet(106,1);		     { A u	}
17   : skiftmagnet(108,1); { B }
18   : begin skiftmagnet(52,1); skiftmagnet(108,1); end; { B }
19   : a1_5:=false;
27..29   : 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	: begin skiftmagnet(106,1); skiftmagnet(49,1); end; { 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);
30,31   : skiftmagnet(103,1);{ C & D    }
32      : skiftmagnet(49,1);       { isol  }
end;
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=11) or (togveje[x].aspect=19) then a1_5:=true;
        end;
if s='-SBO' then togveje[0].fast:=1;
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; end;
if s='LOAD' then begin clearviewport; baggrund; loadseg; write_spskdat; loadspsk; loadspskdat; loadtogv; null:=ordre('FASTL'); 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;
        end;

if copy(s,1,2)='O ' then
        begin
        x:=henttal(s);
        skiftspor(x,spsk[x].rl xor 1);
        case x of
        3       : skiftspor(81,spsk[03].rl);
        9       : skiftspor(82,spsk[09].rl);
        { 10      : skiftspor(80,spsk[10].rl); relais    }
        16      : skiftspor(83,spsk[16].rl);
        17      : skiftspor(88,spsk[17].rl);
        21	: skiftspor(84,spsk[21].rl);
        26      : skiftspor(85,spsk[26].rl);
        27      : skiftspor(86,spsk[27].rl);
        29      : skiftspor(87,spsk[29].rl);
        end;    { case  }
        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'	: noedopl([11..16,17,19,24,25,26]);
        'B'	: noedopl([16,17,18]);
        '7'	: noedopl([1,20..23]);
        'C','D' : noedopl([27..31]);
        else	writeln(tid,' Error in S ',s[3]);
        end;


if s='STARTO' then for x:=0 to spsk_max do if boolean(spsk[x].maga) then
	begin
        spsk[x].kont:=1;
        skiftspor(x,spsk[x].rl);
        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;
        null:=ordre('FASTL');
        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 boolean(s88 and cond[0]) then
        	begin
                testtogvej:=1;
                exit;
                end;

        end;
testtogvej:=0;
end;



begin   { ========================= MAIN =========================== }
writeln(^J,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);

delay(1000);
writeln('Write ',filewrite(handle,chr(193),1));
writeln('Read  ',fileread(handle,s88buffer,1));
writeln('Read  ',fileread(handle,s88buffer,1));
{writeln('S88   ',(s88); delay(10000); end.
==========test}

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;

{ skiftmagnet(49,1); sbo isol  *  delay(500);  }
null:=ordre('FASTL');

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,'*');
end
else
write(^G);



tid:=datetimetostr(now);
if tid<>gltid then
        begin
        setfillstyle(solidfill,black);
        bar(850,10,getmaxx-1,18);
        setcolor(brown);
        outtextxy(850,10,tid);
        gltid:=tid;
        end;


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 boolean(s88 and cond[1]) then
              		begin
                        { if aspect in [11..14,19..26] then begin skiftmagnet(49,0); null:=ordre('ISOL'); end; }
                        oploes1(togveje[x].aspect);
                        togveje[x].fast:=254;
                        if ag then case togveje[x].aspect of
                        4,6     : if (not a1_5) then null:=ordre('H A 6');
                        30      : null:=ordre('H B 6');
                        end;
                        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
        begin
        err:=0;
        if boolean(s88 and cond[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	: begin skiftmagnet(107,1); skiftmagnet(49,0); end; { sbo	}

                2	: skiftmagnet(34,0);
                3	: begin skiftmagnet(59,0); skiftmagnet(34,0); end;
                4	: begin skiftmagnet(60,0); skiftmagnet(33,0); end;
                5	: skiftmagnet(59,0);
                6	: skiftmagnet(60,0);
                7	: skiftmagnet(57,0);
                8	: ;
                9	: skiftmagnet(58,0);
                11	: begin skiftmagnet(50,1); skiftmagnet(102,1); skiftmagnet(49,0); end;
                12      : begin skiftmagnet(53,0); skiftmagnet(51,0); skiftmagnet(54,0); skiftmagnet(56,0); skiftmagnet(106,0); skiftmagnet(49,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); 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); end;{ h 3..5 A	}
                15      : begin skiftmagnet(51,0); skiftmagnet(54,0); skiftmagnet(101,0); end ;{ h 6 A	}
                16      : begin skiftmagnet(52,0); skiftmagnet(50,0); skiftmagnet(102,1); if ag then ordre('H 6 B');end;
                17      : begin skiftmagnet(51,0); skiftmagnet(107,0); if ag then ordre('H 6 A'); end;
                18      : skiftmagnet(108,0);
                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      : skiftmagnet(104,1);
                29      : skiftmagnet(102,0);
                30      : skiftmagnet(103,0);
                31      : skiftmagnet(104,0);
{               32      : skiftmagnet(049,0);  isol }
                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      }


for x:=0 to $ff do if segm[x].xy[0]>0 then
                with segm[x] do begin
                if boolean(mask and s88) 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
setfillstyle(solidfill,blue);
bar(19,ymax-15,400,ymax);
setcolor(white);
lw:=abs(s88-old_s88);
outtextxy(20,ymax-10,'$'+hex(lw,8));
old_s88:=s88;
write(^G);
end;


if s89<>old_s89 then
begin
{if  s88_test then
begin
setfillstyle(solidfill,blue);
bar(19,ymax-15,400,ymax);
setcolor(white);
outtextxy(20,ymax-10,'$'+hex(s89,8)+'      '+'$'+hex(old_s89,8)+'      '+bit(s89,32));
write(^G);
end;
}

if s89=0 then case old_s89 of
        $20 : null:=ordre('O 16');
        $80 : null:=ordre('O 17');
        $40 : null:=ordre('O 18');
        $10 : null:=ordre('O 19');
        $800: null:=ordre('OSB 22');
        $1000:null:=ordre('OSB 23');
        $100: null:=ordre('OSB 24');
        $200: null:=ordre('OSB 25');
        $400: null:=ordre('OSB 29');
        $4000:null:=ordre('OSB 27');
        $2000:null:=ordre('OSB 26');
end;
old_s89:=s89;
end;

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);
        end;

until c in ['Q',^C];

null:=ordre('NALT');
delay(100);
writebyte(97);

programme_end(0);
end.


