DataMuseum.dk

top - metrics - download

    Length: 23808 (0x5d00)
    Types: TextFileVerbose
    Names: »savemb1«

└─⟦a41ae585a⟧ Bits:30001842 SW-save af projekt 1000, Alarm-system
    └─⟦72244f0ef⟧ 
        └─⟦this⟧ »savemb1« 

TextFileVerbose

job jg 8 200 time 2 0
p1=set 80 disc1
o xx
p1=algol list.yes xref.yes
program desp
begin
<* globale variable *>
 
boolean
retabler,       <* retabler spilsituation *>
start,          <* skal rc_8000 starte spillet *>
modif,          <* skal der modificeres i spilparametre *>
flk,            <* desp i fase forklar *>
slut,           <* er spillet slut *>
batch,          <* skal programmet k|re batch *>
sim,            <* skal programmet simulere spilleren *>
a,b;            <* arbejdsvariabel *>
  
integer
spilnr,         <* nummer p} valgte spil *>
char,klasse,    <* var til l{seprocedurerne *>
time,tal,       <* arbejdsvariable *>
i,j,k,          <* arbejdsvariable *>
testniv,        <* nummer p} niveau for testudskrift *>
antal_spil,     <* antallet af forskellige demospil *>
sv{rhed,        <* aktuelle sv{rhedsgrad *>
maxsv{r,        <* st|rste sv{rhedsgrad i aktuelle spil *>
result,         <* resultat af spillet *>
tr{knr,         <* aktuelle tr{knummer *>
tiltr{k,        <* tr{knr til og med i batchk|rsel *>
xtal;           <* tilf{ldig integer *>
     
integer field
inf;
real
r;              <* arbejdsvariabel *>
  
integer array
to(1:12,0:3),   <* testout array *>
ia(1:20),       <* arbejdsarray *>
stat(0:9);      <* spil statistik *>
    
zone
log(2*128,2,stderror);
  
\f


<* globale for spil1 *>
boolean
ens;            <* m} der v{re ens cifre i l|sningen *>
integer
ant_fors|g,     <* antal tilladte fors|g *>
ant_pos,        <* antal positioner i l|sningen *>
ant_var;        <* antal variationer i ant_pos *>
  
<* globale for spil2 *>
integer
ant_felter,     <* antal felter i spillet *>
dim,            <* st|rrelse p} feltet *>
apr,            <* antal p} r{kke der vinder *>
rx,ry;
  
<* globale for spil3 *>
boolean
sidst;          <* den der tager sidste pind vinder *>
integer
ant_bunker;     <* antal bunker i spillet *>
integer array
base_bunker(1:10); <* rummer startindholdet i bunkerne *>
\f


  
procedure readcr;
begin <* l{ser frem til nl i inzonen *>
repeatchar(in);
for klasse:= readchar(in,char) while char<> 'nl' do <*skip*>;
end;
  
integer procedure udtr{k(vari);
integer vari;
begin
random(xtal);
udtr{k:= xtal mod vari + 1;
end;
   
procedure setpos(z);
zone z;
begin
integer kind;
getzone6(z,ia);  kind:= ia(1) extract 12;
if kind=0 or kind=8 or kind=12 or kind=14 then
setposition(z,0,0);
end;
  
  
\f


boolean procedure l{s_jn(no);
integer no;
begin
integer i;
igen:
if no>0 then
begin
readcr;
i:= write(out,<:<6><1><22><14>:>,"sp",2,case no of
<* 1*> (<:vil du begynde:>
<* 2*> ,<:m} der v{re ens cifre i l|sningen:>
<* 3*> ,<:|nskes der en forklaring p} spillet:>
<* 4*> ,<:vil du pr|ve igen:>
<* 5*> ,<:g{lder det om at tage den sidste:>
<* 6*> ,<:skal vi slutte:>
<* 7*> ,<:forklaring |nskes til spil nr: :>
<* 8*> ,<:st|rrelse p} spillet:>
<* 9*> ,<:antal p} r{kke der vinder:>
<*10*> ,<:vil du forts{tte:>
<*11*> ,<:modif slut:>
<*12*> ,<:n{ste:>
<*13*> ,<:ok:>
       ),<:<63> :>);
write(out,"sp",44-i,false add 8,44-i);
setpos(out);
end;
 
for klasse:= readchar(in,char) while char='sp' do <*skip*>;
if char<>'j' and char<>'n' then
begin
if char='?' and -, flk then forklar;
goto igen;
end;
l{s_jn:= char='j';
end;
  
\f


integer procedure l{s_tal(nr,num,max,min);
integer nr,num,max,min;
begin
integer i;
igen:
if nr>0 then
begin
if nr>1 then readcr;
i:= write(out,<:<6><1><22><14>:>,"sp",2,case nr of
<* 1*> (<:v{lg spilnr:>
<* 2*> ,<:sv{rhedsgrad:>
<* 3*> ,<:antal cifre i tallet:>
<* 4*> ,<:st|rste ciffer i tallet:>
<* 5*> ,<:antal fors|g:>
<* 6*> ,<:g{t nr:>
<* 7*> ,<:forklaring |nskes til spilnr:>
<* 8*> ,<:st|rrelse p} spillet:>
<* 9*> ,<:antal p} r{kke der vinder:>
<*10*> ,<:tast et felt:>
<*11*> ,<:antal bunker:>
<*12*> ,<:antal i bunke :>
<*13*> ,<:v{lg bunkenummer og antal:>
<*14*> ,<:var nr:>
<*15*> ,<:tegn:>
<*16*> ,<:index:>
<*17*> ,<:felt nr:>
       ));
if num>-1 then i:=i+write(out,<<ddd>,num);
i:=i+write(out,<: = :>);
write(out,"sp",44-i,false add 8,44-i);
setpos(out);
end;
l{s_nu_tal:
for klasse:= readchar(in,char) while char='sp' do <*skip*>;
if klasse=2 then
begin
repeatchar(in);
read(in,tal);
if tal<min or tal>max then
begin
if nr=0 then tal:= -1 else goto igen;
end;
l{s_tal:= tal;
end
else
begin
if char='m' and nr=1 then
begin
modif:= true;
goto l{s_nu_tal;
end else
if char='b' and nr=1 then
begin
batch:= true;
readchar(in,char);
repeatchar(in);
if char<>'nl' then
read(in,tiltr{k);
end
else if char='a' then goto exit
else if char='n' then goto start_nyt_spil
else if char='f' and spilnr<>0 then goto start_spil
else if char='r' then retabler:= true
else if char='s' then sv{rhed:= l{s_tal(2,-1,maxsv{r,1)
else if char='t' then testniv:= l{s_tal(-1,-1,1023,0)
else if char='u' then sim:= true
else if char='?' and -, flk and nr>0 then forklar;
goto igen;
end;
end;
  
\f


procedure forklar;
begin
integer visnr;
flk:= true;
visnr:= spilnr+1;
vis:
case visnr of
begin
begin
visnr:= l{s_tal(7,-1,antal_spil,1) + 1;
goto vis;
end;
write(out,"ff",1,
"cr",1,
<:der skal g{ttes et tal best}ende af :>,<<dd>,ant_pos,<: cifre,:>,"nl",1,
"cr",1,
<:hvert ciffer kan antage v{rdierne fra 0 til:>,ant_var-1,"nl",1,
"cr",1,
<:der kan:>,if ens then <: :> else <: ikke :>,
<:v{re ens cifre i l|sningen.:>,"nl",1,
"cr",1,
<:der gives:>,<<ddd>,ant_fors|g,<: fors|g p} at finde l|sningen:>,"nl",1,
"cr",1,
<:tast blank mellem cifrene:>,"nl",1,"cr",1);
;
;
;
end;
while -, l{s_jn(13) do;
flk:= false;
retabler:= true;
setpos(out);
end;
    
\f


<*initier globale*>
inf:= 2;
flk:= false;
retabler:= false;
antal_spil:= 2;
for i:=0 step 1 until 9 do stat(i):= 0;
systime(1,time,r);
xtal:= r;
testniv:= 0;
<* initier faste spilparametre *>
<* spil 1 *>
ant_fors|g:= 8;
ens       := true;
ant_pos   := 4;
ant_var   := 10;
<* spil 2 *>
dim       := 15;
apr       := 5;
ant_felter:= dim*dim;
<* spil 3 *>
sidst     := false;
ant_bunker:= 5;
for i:= 1 step 1 until ant_bunker do
base_bunker(i):= 2*i - 1;
open(log,4,<:logfil:>,0);
\f


start_nyt_spil:
modif:= false;
spilnr:= 0;
write(out,"ff",1,<:vers 1.2:>,"nl",2,"cr",1,
"sp",30,<:D E M O S P I L:>,"nl",2,"cr",1);
j:= 0;
for i:=1 step 1 until antal_spil,4,5,6,7 do
begin
j:= j+1;
write(out,case i of(
 _<:master mind ----------------------- ( 1 ):>
,<:kryds og bolle -------------------- ( 2 ):>
,<:nim ------------------------------- ( 3 ):>
,<:forklaring til spillet ------------ ( ? ):>
,<:nyt spil |nskes ------------------- ( n ):>
,<:samme spil forfra ----------------- ( f ):>
,<:afslut demospil ------------------- ( a ):>),"nl",1,"cr",1);
end;
setpos(in);
setpos(out);
batch:= false;
sim  := false;
tiltr{k:= 0;
spilnr:= l{s_tal(1,-1,antal_spil,1);
\f


<* initier spilparametre *>
   
start   := case spilnr of (false,true,false,false,false);
maxsv{r := case spilnr of ( 0, 3, 0, 0, 0 );
sv{rhed := case spilnr of ( 1, 3, 1, 0, 0 );
for i:=1 step 1 until 12 do to(i,0):= 0;
\f


<* modificer parametre *>
  
if modif then
begin
if maxsv{r>0 then sv{rhed:= l{s_tal(2,-1,maxsv{r,1);
b:= case spilnr of (false,true,false,false,false);
if b then start:= -, l{s_jn(1);
  
case spilnr of
begin
begin <* spil 1 *>
ens:= l{s_jn(2);
ant_pos:= l{s_tal(3,-1,10,1);
for ant_var:= 1+l{s_tal(4,-1,9,0) while
( -, ens and ant_var<ant_pos ) do;
ant_fors|g:= l{s_tal(5,-1,100,1);
end;
begin <* spil 2 *>
dim:= l{s_tal(8,-1,20,3);
apr:= l{s_tal(9,-1,5,3);
ant_felter:= dim*dim;
end;
end case;
end modif;
\f


start_spil:
  
slut    := false;
result  := 0;
tr{knr  := 0;
  
case spilnr of
begin
begin <* master mind *>
integer
cifok,         <* antal rigtige positioner *>
ciferder,      <* antal rigtige cifre *>
plus,minus,
i,j,a,b,c;     <* arbejdsvariable *>
integer array
l|sning (1:ant_pos),
liste   (1:ant_fors|g),
g{t     (1:ant_pos,1:ant_fors|g);
   
<* lav l|sning *>
for i:=1 step 1 until ant_pos do
begin
l|sning(i):= udtr{k(ant_var)-1;
if -, ens then
for j:=1 step 1 until i do
if l|sning(i)=l|sning(j) and i<>j then i:= i-1;
end;
  
<* start spil *>
result:= -1;
write(out,"nl",1);
while -, slut and tr{knr<ant_fors|g do
begin
tr{knr:= tr{knr + 1;
l{s_ny:
for i:=1 step 1 until ant_pos do
begin
g{t(i,tr{knr):= if i=1 then l{s_tal(6,tr{knr,ant_var-1,0) else
l{s_tal(0,-1,ant_var-1,0);
if g{t(i,tr{knr)=-1 then goto l{s_ny;
end;
cifok:= ciferder:= 0;
for j:= 0 step 1 until ant_var-1 do
begin
plus:= minus:= 0;
for i:=1 step 1 until ant_pos do
begin
a:= if l|sning(i)=j then 1 else 0;
b:= if g{t(i,tr{knr)=j then 1 else 0;
c:= a-b;
case c+2 of
begin
minus:= minus+1;
;
plus := plus+1;
end;
end;
cifok:= cifok+minus;
ciferder:= ciferder + (if plus>minus then minus else plus);
end;
cifok:= ant_pos-cifok;
write(out,false add 24,30,false add 26,1);
for j:= 1 step 1 until ant_pos do
write(out,<<dd>,g{t(j,tr{knr));
write(out,<:  =>  :>,"+",cifok,"sp",ant_pos-cifok,"-",ciferder,"nl",2);
liste(tr{knr):= cifok shift 12 + ciferder;
if cifok=ant_pos then
begin
slut:= true;
result:= 1;
end;
end tr{knr;
for i:= 1 step 1 until ant_pos do ia(i):= l|sning(i);
end master mind;
\f


begin <* kryds og bolle *>
integer
base0,base1,base2,basex,
i,j,k,kryds,bolle,ialt,
trx,try;    <* fundne modtr{k *>
integer array
stilling (1:dim,1:dim),
tr{k     (1:ant_felter),
liste    (-apr:apr),
adr      (-apr:apr),
r{kke    (-apr:apr),
felt     (-apr:apr),
<*var 1*> styrke   (1:2),      <* max styrke i felt *>
<*var 2*> gemfelt  (1:4,0:8*apr),
<*var 3*> modtr{k  (0:dim*dim),  <* resterende tomme felter *>
<*var 4*> kandidat (1:2,0:dim*dim),
<*var 5*> chance   (1:2,1:dim,1:dim),
<*var 6*> tryk     (1:2,1:dim,1:dim),
<*var 7*> ktryk    (1:2,1:dim,1:dim),
<*var 8*> kombi    (1:2,1:dim,1:dim);
\f


procedure update_spil2(x,y,tegn);
integer x,y,tegn;
begin
integer i, char;
if retabler then vis_spil2(stilling);
stilling(x,y):= tegn;
tr{k(tr{knr):= x shift 6 + y;
for char:=6, x, dim-y do
outchar( out, char);
for i:=1 step 1 until 1+2*x do  outchar(out,24);
write( out, case tegn+1 of (
<:-:>, <:x:>, <:o:>));
if tr{knr=2 then
write(out,<:<6><1><21><14>:>,"sp",11);
write(out,<:<6><1><21><14>:>,
if tegn=kryds == start then <:kryds:> else <:bolle:>,
<<ddd>,x,<: -:>,y);
setpos(out);
i:= 0;
for i:=i+1 while modtr{k(i)<>tr{k(tr{knr) do;
modtr{k(i):= modtr{k(modtr{k(0));
modtr{k(0):= modtr{k(0)-1;
write(log,"nl",1,<:tr{k:>,<<ddd>,tr{knr,
if tegn=kryds then <: rc8000 :> else <: player :>,x,y);
end;


\f


procedure udskr2(vent);
boolean vent;
begin
integer i,j,k,a,b,c;
if testniv extract 1=1 then
begin <* modif testout *>
modom:
a:= l{s_tal(17,-1,12,1);
i:= to(a,0):= l{s_tal(14,-1,8,0);
if i<>0 then
begin
b:= case i of (2,4,dim*dim,2,2,2,2,2);
to(a,1):= l{s_tal(16,1,b,if i=3 then 0 else 1);
b:= case i of (
0, 8*apr, 0, dim*dim, dim, dim, dim, dim);
c:= case i of (
0, 0, 0, 0, 1, 1, 1, 1);
if b>0 then to(a,2):= l{s_tal(16,2,b,c);
b:= case i of (
0, 0, 0, 0, dim, dim, dim, dim);
c:= case i of (
0, 0, 0, 0, 1, 1, 1, 1);
if b>0 then to(a,3):= l{s_tal(16,3,b,c);
end;
if -, l{s_jn(11) then goto modom else
testniv:= testniv shift (-1) shift 1;
end modif;
  
write(out,<:<6><1><23><14>:>);
for i:=1 step 1 until 12 do
begin
k:= to(i,0);
if k=0 then write(out,"sp",6)
else
begin
a:= to(i,1);
b:= to(i,2);
c:= to(i,3);
write(out,<<dddddd>,case k of (
styrke(a),
(case a of (
(gemfelt(1,b) shift (-6))*100+gemfelt(1,b) extract 6,
0,0,0)),
(modtr{k(a) shift (-6))*100 + modtr{k(a) extract 6,
(kandidat(a,b) shift (-6))*100+kandidat(a,b) extract 6,
chance(a,b,c),
tryk(a,b,c),
ktryk(a,b,c),
kombi(a,b,c)));
end;
end for i;
if vent then
begin
if l{s_jn(12) then goto modom;
end;
end udskr2;
\f


procedure vis_spil2(st);
integer array st;
begin
integer k,l;
write(out,"ff",1);
for k:= dim step -1 until 1 do
begin
write(out,<<dd>,k);
for l:=1 step 1 until dim do
write(out,case st(l,k)+1 of (
<: -:>,<: x:>,<: o:>));
write(out,"nl",1,"cr",1);
end;
for k:=0 step 1 until dim do
write(out,<<dd>,k mod 10);
if tr{knr=0 then
write(out,<:<6><1><21><14>sv{rhed =:>,<<dd>,sv{rhed);
setpos(out);
retabler:= false;
end;
  
boolean procedure nyt_felt(x,y,retning);
<* x,y er koordinaterne til feltet hvorfra der beregnes
nytfelts x,y i aktuelle retning,nyt_felt=true hvis felt findes *>
integer x,y,retning;
begin
integer ax,ay;
ax:= x + (case retning of ( 0, 1, 1, 1, 0,-1,-1,-1));
ay:= y + (case retning of ( 1, 1, 0,-1,-1,-1, 0, 1));
if ax<=dim and ax>0 and
   ay<=dim and ay>0 then
begin
nyt_felt:= true;
x:= ax;
y:= ay;
end else
nyt_felt:= false;
end;
\f


procedure check_r{kke(st,x,y,retning,tegn);
integer array st;
integer x,y,retning,tegn;
begin
integer k;
for k:= -apr step 1 until apr do
begin
liste(k):= adr(k):= 0;
felt (k):= r{kke(k):= 0;
end;
for k:= retning, retning+4 do
check_retning(st,x,y,k,tegn);
liste(0):= liste(0)-1;
end;
\f


procedure check_retning(st,x,y,retning,tegn);
integer array st;
integer x,y,retning,tegn;
begin
integer ax,ay,antal,akt_tegn,fase,sign;
boolean f{rdig , nyt_tegn;
  
sign:= if retning<5 then 1 else -1;
f{rdig:= false;
nyt_tegn:= false;
ax:= x;  ay:= y;  antal:= -1;  fase:= 0;
akt_tegn:= st(x,y);
for antal:=antal+1 while
antal<=apr-1 and -, f{rdig do
begin
r{kke(antal*sign):= st(ax,ay);
felt (antal*sign):= ax shift 6 + ay;
if st(ax,ay)<>akt_tegn then
begin <* nyt tegn *>
akt_tegn:= st(ax,ay);
fase:= fase + sign;
adr(fase):= ax shift 6 + ay;
end;
if -, nyt_tegn then
begin
nyt_tegn:= akt_tegn=3-tegn;
if nyt_tegn then r{kke(sign*apr):= antal;
end;
liste(fase):= liste(fase) + 1;
f{rdig:= -, nyt_felt(ax,ay,retning);
end;
felt(sign*apr):= antal-1;
if -, nyt_tegn then r{kke(sign*apr):= antal;
end;
\f


procedure fmt(tegn,trx,try,sv);
integer tegn,trx,try,sv;
begin
integer a,b,i,j,k,m,nykombi,kryds,bolle;
kryds:= tegn;
bolle:= 3-tegn;
case sv of
begin
begin <* sv 1 *>
k:= udtr{k(modtr{k(0));
trx:= modtr{k(k) shift (-6);
try:= modtr{k(k) extract 6;
end <* sv 1 *>;
begin <* sv 2 *>
m:= k:= 0;
styrke(kryds):= 0;
for b:=1 step 1 until modtr{k(0) do
begin
i:= modtr{k(b) shift (-6);
j:= modtr{k(b) extract 6;
a:= chance(kryds,i,j) + chance(bolle,i,j);
if a>0 then
begin
m:= m+1;
if a>styrke(kryds) then
begin
styrke(kryds):= a;
k:= 1;
kandidat(kryds,k):= i shift 6 + j;
end
else
if a=styrke(kryds) then
begin
k:= k+1;
kandidat(kryds,k):= i shift 6 + j;
end;
end;
end;
   
if k>0 then
begin
b:= udtr{k(k);
trx:= kandidat(kryds,b) shift (-6) extract 6;
try:= kandidat(kryds,b) extract 6;
end;
if m<2 then
begin
if l{s_jn(6) then
begin
slut:= true;
result:= 1;
end;
end;
end <* sv 2 *>;
begin <* sv 3 *>
m:= 0;
styrke(kryds):= styrke(bolle):= 0;
kandidat(kryds,0):= kandidat(bolle,0):= 0;
for a:= 1 step 1 until modtr{k(0) do
begin
i:= modtr{k(a) shift (-6) extract 6;
j:= modtr{k(a) extract 6;
for b:= kryds,bolle do
begin
nykombi:= tryk(b,i,j)*10000+ktryk(b,i,j)*100+chance(b,i,j);
k:= nykombi;
if nykombi>0 then
begin
m:= m+1;
if k>styrke(b) then
begin
styrke(b):= k;
kandidat(b,0):= 1;
kandidat(b,1):= modtr{k(a);
end else
if k=styrke(b) then
begin
kandidat(b,0):= kandidat(b,0) + 1;
kandidat(b,kandidat(b,0)):= modtr{k(a);
end;
end;
if nykombi<>kombi(b,i,j) then
begin
kombi(b,i,j):= nykombi;
write(log,"nl",1,<:x-y-t:>,<<ddd>,i,j,b,
<<ddd dd dd>,nykombi);
end;
end;
end;
i:= styrke(kryds)//10000;
j:= styrke(bolle)//10000;
k:=
if tr{knr<apr then bolle else
if i=basex then kryds else
if i=base0 and j<=base0 then kryds else
if i=base1+1 and j<=base1+1 then kryds else
if i=base1 and j<=base0 then kryds else
if i=base2 and j<=base1 then kryds else
if i<base2 and j<base2 then kryds else
bolle;
if styrke(k)>0 then
begin
kandidat(3-k,0):= 0;
styrke(3-k):= 0;
for a:=1 step 1 until kandidat(k,0) do
begin
i:= kandidat(k,a) shift (-6);
j:= kandidat(k,a) extract 6;
b:= kombi(k,i,j) + kombi(3-k,i,j);
if b>styrke(3-k) then
begin
styrke(3-k):= b;
kandidat(3-k,0):= 1;
kandidat(3-k,1):= kandidat(k,a);
end
else
if b=styrke(3-k) then
begin
kandidat(3-k,0):= kandidat(3-k,0) + 1;
kandidat(3-k,kandidat(3-k,0)):= kandidat(k,a);
end;
end;
b:= udtr{k(kandidat(3-k,0));
trx:= kandidat(3-k,b) shift (-6) extract 6;
try:= kandidat(3-k,b) extract 6;
end;
if m<2 then
begin
if l{s_jn(6) then
begin
slut:= true;
result:= 1;
end;
end;
end <* sv 3 *>;
end case;
end;
\f


integer procedure dan_chance(st,x,y,tegn);
integer array st;
integer x,y,tegn;
begin
integer j,k,antal;
antal:= 0;
for k:= 1 step 1 until 4 do
begin
check_r{kke(st,x,y,k,tegn);
j:= r{kke(-apr)+r{kke(apr)-1;
if j>=apr then
antal:= antal + j - apr + 1;
end;
dan_chance:= antal;
end;
   
\f


  
procedure check_stilling(st,x,y,tegn);
integer array st;
integer x,y,tegn;
begin
integer i,j,k,m,ant,p,t;
gemfelt(1,0):= i:= 0;
for k:= 1,k+1 while -, slut and k<=4 do
begin
check_r{kke(st,x,y,k,tegn);
if testniv shift (-4) extract 1=1 then udskr2(true);
if liste(0)>=apr then
begin <* spillet er slut *>
slut:= true;
result:= if start then 4-tegn else tegn+1;
end else
begin <* analyser *>
<* find relevante tomme felter *>
if sv{rhed>1 then
begin <* find felter til y chanceberegning *>
for j:= -felt(-apr) step 1 until felt(apr) do
if felt(j)<>0 and r{kke(j)=0 then
begin
i:= i+1;
gemfelt(1,i):= felt(j);
end;
end;
   
end;
end for k;
gemfelt(1,0):= i;
<* opdater tabeller *>
if sv{rhed>1 then
begin
if testniv shift (-2) extract 1=1 then udskr2(true);
chance(tegn,x,y):= chance(3-tegn,x,y):= 0;
if gemfelt(1,0)>0 then
for k:=1 step 1 until gemfelt(1,0) do
begin
i:= gemfelt(1,k) shift (-6) extract 6;
j:= gemfelt(1,k) extract 6;
ktryk(kryds,i,j):=
ktryk(bolle,i,j):=
tryk(kryds,i,j):=
tryk(bolle,i,j):= 0;
chance(3-tegn,i,j):= 0;
if sv{rhed>2 then chance(tegn,i,j):= 0;
for m:= 1 step 1 until 4 do
begin
if sv{rhed=2 then
begin
check_r{kke(st,i,j,m,3-tegn);
ant:= r{kke(-apr) + r{kke(apr) -1;
if ant>=apr then
chance(3-tegn,i,j):=
chance(3-tegn,i,j) + ant - apr + 1;
end;
if sv{rhed>2 then
begin
check_r{kke(st,i,j,m,0);
for p:= kryds,bolle do
begin
t:= check_tryk(p,i,j);
if tryk(p,i,j)=base2 and t=base2 then
tryk(p,i,j):= base1+1 else
if (tryk(p,i,j)=base1 or tryk(p,i,j)=base2)
and (t=base1 or t=base2) then tryk(p,i,j):= base0 else
if tryk(p,i,j)<t then tryk(p,i,j):= t;
end;
end;
end;
end;
if testniv shift (-3) extract 1=1 then udskr2(true);
end;
end;
\f


integer procedure check_tryk(tegn,x,y);
integer tegn,x,y;
begin
integer tryk,antblank,fase,j,k,m,anttegn,antr{kke,lgdrk;
boolean slut,blank,t,tslut;
integer array kt(-1:1);
tryk:= 0;
antr{kke:= 0; <* antal tegn umiddelbart op til det blanke felt *>
antblank:= 1;
anttegn := 0;
lgdrk   := 1;
for fase:= -1,1 do
begin
t:= true;
tslut:= false;
slut:= false;
blank:= false;
k:= felt(fase*apr);
kt(fase):= 0;
j:= 0;
for j:=j+1 while -, slut and j<=k do
begin
m:= j*fase;
if r{kke(m)=3-tegn then
slut:= true else
if r{kke(m)=tegn then
begin
if -, tslut then
begin
tryk:= tryk + (if blank then 2 else 4);
lgdrk:= lgdrk + 1;
end;
blank:= false;
if t then antr{kke:= antr{kke + 1;
anttegn:= anttegn + 1;
kt(fase):= kt(fase) + apr - j;
end else
begin
if blank or tslut then
tslut:= true else
begin
tryk:= tryk + 2;
lgdrk:= lgdrk + 1;
blank:= true;
t    := false;
end;
antblank:= antblank + 1;
end;
end for j;
end for fase;
k:= antblank + anttegn;
if k>=apr then
begin
chance(tegn,x,y):= chance(tegn,x,y) + k - apr + 1;
ktryk(tegn,x,y):= ktryk(tegn,x,y) + kt(-1) + kt(1);
end;
if tryk>base0 then tryk:= base0;
if antr{kke>=apr-1 then tryk:= basex else
if tryk>base1 and antr{kke<apr-2 then tryk:= base1 else
if tryk=base2 and antr{kke=0 and anttegn=apr-2 then tryk:= base1;
check_tryk:= if k>=apr and anttegn>0 then tryk else 0;
end procedure;
\f


procedure start_batch;
begin
integer tr,i;
boolean slut;
slut:= false;
tr:= 0;
setposition(log,0,49);
inrec6(log,2);
tr:= log.inf;
i:= 0;
while -, slut do
begin
i:= i+1;
inrec6(log,2);
tr{k(i):= log.inf;
if i=tiltr{k or i=tr then slut:= true;
end;
tiltr{k:= i;
end;
\f


<***** her startet kryds og bolle *****>
  
kryds:= if start then 1 else 2;
bolle:= if start then 2 else 1;
if batch then start_batch else
for i:=1 step 1 until ant_felter do tr{k(i):= 0;
  
base0:= 4*(apr-1);
base1:= base0-2;
base2:= base1-2;
basex:= 2*base0;
styrke(kryds):= styrke(bolle):= 0;
kandidat(kryds,0):= kandidat(bolle,0):= 0;
for i:=1 step 1 until dim do
for j:=1 step 1 until dim do
begin
modtr{k( (i-1)*dim + j ):= i shift 6 + j;
stilling(i,j):= 0;
tryk(kryds,i,j):=
tryk(bolle,i,j):=
ktryk(kryds,i,j):=
ktryk(bolle,i,j):=
kombi(kryds,i,j):=
kombi(bolle,i,j):= 0;
end;
modtr{k(0):= dim*dim;
for i:= 1 step 1 until dim do
for j:= 1 step 1 until dim do
chance(kryds,i,j):=
chance(bolle,i,j):=
dan_chance(stilling,i,j,0);
if testniv extract 1=1 then udskr2(true);
vis_spil2(stilling);
setposition(log,0,0);
write(log,"nl",1,<<ddd>,<:dim:>,dim,<:  apr:>,apr);
   
repeat
tr{knr:= tr{knr + 1;
if (tr{knr mod 2 = 1) == start then
\f


begin <* rc8000 *>
if batch and tr{knr<=tiltr{k then
begin
trx:= tr{k(tr{knr) shift (-6) extract 6;
try:= tr{k(tr{knr) extract 6;
end else
begin
trx:= 0;
if trx=0 and sv{rhed>2 then fmt(kryds,trx,try,3);
if trx=0 and sv{rhed>1 then fmt(kryds,trx,try,2);
if trx=0 then fmt(kryds,trx,try,1);
end;
 
  
update_spil2(trx,try,kryds);
check_stilling(stilling,trx,try,kryds);
end <* rc8000 *>
else
begin <* spiller *>
nyt_tr{k:
if testniv extract 2<>0 then udskr2(false);
if batch and tr{knr<=tiltr{k then
begin
trx:= tr{k(tr{knr) shift (-6) extract 6;
try:= tr{k(tr{knr) extract 6;
end else
if sim then
begin
trx:= 0;
if trx=0 and sv{rhed>2 then fmt(bolle,trx,try,3);
if trx=0 and sv{rhed>1 then fmt(bolle,trx,try,2);
if trx=0 then fmt(bolle,trx,try,1);
end else
begin
trx:= l{s_tal(10,-1,dim,1);
try:= l{s_tal( 0,-1,dim,1);
if try=-1 then goto nyt_tr{k;
if stilling(trx,try)<>0 then goto nyt_tr{k;
end;
update_spil2(trx,try,bolle);
check_stilling(stilling,trx,try,bolle);
end spiller;
until slut or tr{knr=ant_felter;
  
write(log,<:<25><25><25>:>);
getposition(log,0,i);
setposition(log,0,49);
outrec6(log,2);
log.inf:= tr{knr;
for j:=1 step 1 until tr{knr do
begin
outrec6(log,2);
log.inf:= tr{k(j);
end;
setposition(log,0,i+1);
 
end kryds og bolle;
end case spilnr;
\f


<* spil slut *>
case spilnr of
begin
begin <* spil 1 *>
stat(5):= stat(5) + result;
write(out,"nl",1,"cr",1);
if slut then
write(out,<:du vandt i:>,<<ddd>,tr{knr,<: fors|g !!!:>,"nl",1)
else
begin
write(out,<:du tabte , l|sningen er :>);
for i:= 1 step 1 until ant_pos do
write(out,<<dd>,ia(i));
end;
end spil 1;
begin <* spil 2 *>
write(out,<:<6><1><21><14>:>,case result+1 of (
<:det blev uafgjort , tak for spillet:>,
<:det blev uafgjort:>,
<:du vandt , tillykke:>,
<:du tabte !!!     :>));
stat(result):= stat(result) + 1;
end spil 2;
end case;
<* afslut aktuelle spil *>
  
setpos(out);
if l{s_jn(4) then goto start_spil
else goto start_nyt_spil;
  
exit:
write(out,"nl",1);
write(log,<:<25><25><25><25>:>);
close(log,true);
end;
o c
scope login p1
scope login xx
finis

«eof»