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 (bsegm[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 b1 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.