|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 46848 (0xb700)
Types: TextFile
Names: »s5f«
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
└─⟦4334b4c0b⟧
└─⟦this⟧ »s5f«
; gomuko codepr * page 1 08 04 81, 17.07;
begin
integer procedure alphabeta(depth, alpha, beta);
value depth, alpha, beta;
integer depth, alpha, beta;
begin
integer actmover, widthlimit, newalpha, totval1,
maxtries, cr3, cr4, prm, prnx;
boolean array try(1:trywidth);
boolean defmove;
boolean field ij, mn, next, w;
procedure selecttry(entry, crlimit);
value entry, crlimit;
integer entry, crlimit;
begin
integer r, c, m, prnx;
boolean field next, u, v;
boolean select;
if selecttest then write(testlog, <:<10>:>,
case actmover of (<:X:>, <:O:>), <: SEL:>, false add 32,
depth+1, <<ddd>, crlimit, <<ddddd>, entry);
if crlimit=-2 then maxtries:= 1;
if depth=threatdepth(mover) and crlimit>-2 then maxtries:= 0;
select:= defmove or defense(depth-2) or crlimit<1;
prnx:= entry;
for prnx:= propose(prnx+1) shift (-1)
while prnx<1676 and w<maxtries do
begin
next:= prnx shift (-1);
if selecttest then
begin
write(testlog, <: :>);
writefield(testlog, next);
end;
if totval(next) extract 7 >= crlimit then
begin
v:= 0;
u:= (next shift (-1) shift 1) +actmover-1;
for v:= v+1 while v<=w
and try.v extract 10 <> u do ;
if v>w then
begin
if -, select then
begin
v:= moveno+depth-1;
for v:= v-2 while v>=moveno and -, select do
begin
m:= moves.v extract 10;
r:= abs(u mod 42 - m mod 42)//2;
c:= abs(u//42 - m//42);
if r+c<5 or r=c then select:= true
end
end;
if select then
begin
if selecttest then write(testlog, <:+:>);
w:= w+1;
try.w:= false add (u+(if crlimit=-2 then 2048 else 0)
+(if defmove then 1024 else 0))
end
end
else
if try.v extract 12 < 1024 and defmove then
try.v:= try.v add 1024
end
end;
end selecttry;
actmover:= mover+(-mover+(3-mover))*(1-(depth extract 1));
prm:= 2*actmover;
defmove:= false;
maxtries:= trywidth;
cr3:= creative(mover, 3)+creative(mover, 2)*(depth-1);
cr4:= creative(mover, 4)+creative(mover, 5)*(depth-1);
w:= 0;
i:= 1;
for ij:= 166+prm, 172-prm,
250+prm, 256-prm,
418+prm, 424-prm do
if propose(ij+1) = 3352 then i:= i+1
else goto casei;
casei:
case i of
begin
begin
comment own5, win;
selecttry(166+prm, -2)
end;
begin
comment opp5;
selecttry(172-prm, 0)
end;
begin
comment own-open4.
closed4+open3 => own-open4+own-closed4+opp-open4+opp-closed4,
2*closed4 or open4 => ownopen4, win;
ij:= 250+prm;
for mn:= propose(ij+1) shift (-1)
while mn<1676 and totval(mn shift (-1)) extract 14 < 5*128 do ij:= mn;
if mn=1676 and depth<6 then
begin
selecttry(250+prm, 0);
selecttry(334+prm, cr4);
defmove:= true;
selecttry(256-prm, 0);
selecttry(340-prm, cr4)
end
else
if mn<1676 then selecttry(ij, -2)
else
selecttry(250+prm, -2)
end;
begin
comment opp-open4 => ownclosed4+oppopen4+oppclosed4;
defmove:= true;
selecttry(256-prm, 0);
if w<2 then
begin
if depth>4 then
selecttry(334+prm, cr4);
selecttry(340-prm, cr4);
selecttry(424-prm, cr3);
selecttry(508-prm, cr3)
end;
if depth<5 then
selecttry(334+prm, 1);
end;
begin
comment own-double3.
not opp-closed4 => own-double3, win
else owndouble3+ownclosed4+oppclosed4;
defmove:= true;
selecttry(340-prm, cr4);
defmove:= false;
if w=0 then selecttry(418+prm, -2)
else
begin
selecttry(418+prm, 0);
b:= try(w);
try(w):= try(1);
try(1):= b;
end
end;
begin
comment opp-double3 => ownclosed4+ownsingle3+oppdouble3;
defmove:= true;
selecttry(334+prm, cr4);
selecttry(502+prm, cr3);
selecttry(424-prm, 0);
selecttry(508-prm, cr3);
selecttry(340-prm, cr4)
end;
begin
comment ingen dobbelttrusler;
comment ownclosed4+ownsingle3+oppclosed4+strategiske træk;
selecttry(334+prm, cr4);
selecttry(502+prm, cr3);
defmove:= true;
ij:= 1994+prm;
mn:= 2000-prm;
maxtries:= w+width(mover, depth);
for prnx:= (if ij >= mn-2 then ij else mn)
while w<maxtries and (ij>0 or mn>0) do
begin
if propose(prnx+1) < 3352 then
begin
if prnx = ij then
selecttry(prnx, 1)
else
selecttry(prnx, 1)
end;
if prnx = ij then
begin
for ij:= ij-4 while propose(ij+1) > 3350 do
end
else
for mn:= mn-4 while propose(mn+1) > 3350 do ;
if ij>0 then
begin
if propose(ij+1) = 0 then ij:= 0;
end;
if mn>0 then
begin
if propose(mn+1) = 0 then mn:= 0
end
end next;
maxtries:= trywidth;
selecttry(340-prm, cr4);
selecttry(508-prm, cr3);
end;
end case i;
widthlimit:= w;
if depth=1 then
begin
if w=0 then
begin
row:= bestmove//2 mod 21;
col:= bestmove//2//21;
for ij:= 1 step 1 until 19 do
for i:= -ij step 1 until ij do
for j:= -ij step 1 until ij do
if (abs i=ij or abs j=ij) and
row+i>0 and row+i<20 and col+j>0 and col+j<20 then
begin
bestmove:= (row+i+(col+j)*21)*2+mover-1;
pq:= bestmove+3-2*mover;
if totval(bestmove) > 16383
and totval(pq) > 16383 then goto firstbestmove
end
end
else
begin
w:= 1;
bestmove:= try.w extract 10
end
end;
firstbestmove:
for i:= depth step 1 until 13 do
bestseq(depth, i):= 42;
timebase(depth):= timebase(depth-1);
newalpha:= stratval*((depth extract 1 shift 1) -1);
if w=0 and newalpha>alpha then alpha:= newalpha;
w:= 0;
for w:= w+1 while w<=widthlimit and alpha<beta do
begin
next:= try.w extract 10;
ij:= moveno+depth-1;
moves.ij:= false add next;
totval1:= totval(next) extract 14;
nodes:= nodes+1;
node(depth):= node(depth)+1;
steptest:
if alphatest then
begin
if lookaheadstep then
begin
write(out, xymode, 1, <:<96><22><30>:>, false add 32, 60, <:<13>try=:>);
for mn:= 1 step 1 until widthlimit do
begin
writefield(out, try.mn extract 10);
write(out, <: :>);
end;
write(out, <: commands::>);
setposition(out, 0, 0);
setposition(in, 0, 0);
i:= readchar(in, char);
if char>116 or i=7 then
begin
treatcommands;
goto steptest
end;
end;
writemoves(out, ij-mw, ij);
changeboard(ij, true);
writealphatest(actmover, depth, next,
boardvalue(mover), newalpha, alpha, beta, bestmove);
end;
comment boardvalue ses fra Xs synspunkt,
stratval ses fra moverens synspunkt,
alpha og newalpha ses fra actmoverens synspunkt;
if depth=stdepth or moveno+depth>maxmoves
or (widthlimit=1 and depth=1) then
begin
colsum(actmover):= colsum(actmover)+next//2//21;
rowsum(actmover):= rowsum(actmover)+next//2 mod 21;
stratval:= boardvalue(mover)*(3-2*mover)
+(totval1 extract 7 shift (-1))*((depth extract 1 shift 1) -1)
+round(3*balance*sqrt((rowsum(1)//((moveno+depth+1)//2)
-rowsum(2)/((moveno+depth)//2))**2
+(colsum(1)/((moveno+depth+1)//2)
-colsum(2)/((moveno+depth)//2))**2));
colsum(actmover):= colsum(actmover)-next//2//21;
rowsum(actmover):= rowsum(actmover)-next//2 mod 21
end;
if try.w extract 12 >= 2048 then newalpha:= 901-depth
-(if totval1>=11*128 then 0 else
if totval1>=5*128 then 2 else 4)
else
if depth=threatdepth(mover) or moveno+depth>maxmoves
or (moveno<6 and depth=stdepth)
or (widthlimit=1 and depth=1) then
newalpha:= stratval*((depth extract 1 shift 1) -1)
else
begin
defense(depth):= defense(depth-2) and try.w extract 11 >= 1024;
move(next, depth);
timeslice(depth):= timeslice(depth-1)*slice(widthlimit, w);
newalpha:= alphabeta(depth+1, -beta, -alpha);
move(next, depth);
timebase(depth):= timebase(depth)+timeslice(depth);
systime(1, movestart, movetime);
if movetime>timebase(depth-1)+timeslice(depth-1)
or (movetime+4 > timeslice(0) and depth = 1) then
w:= widthlimit
end;
if depth=1 and -, alphatest then
begin
writefield(testlog, next);
write(testlog, <<-dd>, newalpha, <: :>);
writefield(out, next);
write(out, <<-dd>, newalpha, <: :>);
setposition(out, 0, 0)
end;
if newalpha>alpha then
begin
for i:= depth+1 step 1 until 13 do
bestseq(depth, i):= bestseq(depth+1, i);
bestseq(depth, depth):= next;
alpha:= newalpha;
if depth=1 then bestmove:= next
end;
if alphatest then
begin
writemoves(out, moveno+depth-mw-2, moveno+depth-2);
changeboard(moveno+depth-1, false);
writealphatest(actmover, depth, next,
boardvalue(mover), newalpha, alpha, beta, bestmove);
end
end w;
if alphatest and alpha>=beta then
write(testlog, <:<10> CUT-OFF :>, widthlimit, widthlimit-w+1);
alphabeta:= -alpha
end alphabeta;
\f
comment gomuko * page 2 19 03 81, 18.25
0 1 2 3 4 5 6 7 8 9 ;
procedure move(xy, depth);
value xy, depth;
integer xy, depth;
begin
procedure propose_delete;
begin
comment
if movetest then writemovetest(<: DEL:>, gh, depth);
rs:= propose(gh) shift (-1);
tu:= propose(gh+1) shift (-1);
propose(rs+1):= tu shift 1;
propose(tu):= rs shift 1;
propose(gh+1):= 0
end propose_delete;
procedure propose_insert;
begin
rs:= (totval1 extract 7 shift 2)+(actmover+837)*2;
if threatval > 0 then
rs:= threat(threatval)+actmover*2;
comment
if movetest then writemovetest(<: INS:>, gh, depth);
tu:= propose(rs+1) shift (-1);
propose(rs+1):= gh shift 1;
propose(gh):= rs shift 1;
propose(gh+1):= tu shift 1;
propose(tu):= gh shift 1
end propose_insert;
\f
comment gomuko * page 3 19 03 81, 18.25
0 1 2 3 4 5 6 7 8 9 ;
integer actmover, pm1, distance, distsign, ws, dir, wing, ffield, dw,
threatval, totval1, totval2, actopp, updmover;
boolean field gh, ij, mn, pq, rs, tu;
boolean met1, met2, backwards, dsb;
integer array cval(0:4);
actmover:= (xy extract 1) +1;
comment actopp:= 3-actmover;
pm1:= 1-(xy extract 1 shift 1);
ij:= xy;
gh:= ij shift 1;
comment
if movetest then writemovetest(<: MOV:>, ij, depth);
totval1:= totval(ij);
pq:= ij+pm1;
totval2:= totval(pq) extract 14;
if totval1 > 16383 then
begin
comment feltet er frit, det besættes;
backwards:= false;
totval1:= totval1 extract 14;
totval(ij):= totval1;
boardvalue(mover):= boardvalue(mover) + (totval1 extract 7)*pm1;
colsum(actmover):= colsum(actmover)+ij//2//21;
rowsum(actmover):= rowsum(actmover)+ij//2 mod 21;
distsign:= 32;
if propose(gh+1) > 0 then propose_delete;
gh:= pq shift 1;
if propose(gh+1) > 0 then proposedelete;
end
else
begin
comment feltet er besat, det frigives;
backwards:= true;
totval(ij):= totval1+16384;
boardvalue(mover):= boardvalue(mover)-(totval1 extract 7)*pm1;
colsum(actmover):= colsum(actmover)-ij//2//21;
rowsum(actmover):= rowsum(actmover)-ij//2 mod 21;
distsign:= 40;
threatval:= totval1 shift (-7);
if totval1 extract 7 > proposelow(mover, actmover)
or threatval > 0 then
propose_insert;
threatval:= totval2 shift (-7);
if totval2 extract 7 > proposelow(mover, 3-actmover)
or threatval > 0 then
begin
gh:= pq shift 1;
totval1:= totval2;
actmover:= 3-actmover;
propose_insert
end
end;
cval(0):= if depth<stdepth or backwards then 1 else 0;
cval(1):= 4*mover;
cval(2):= 2*distsign;
cval(3):= 2*pm1;
cval(4):= 2*xy;
moveupdate(totval,env,envval,propose,proposelow,cd,cval);
comment if envtest then writeenv(testlog, env);
comment if totvaltest then
begin
i:= 3*mover;
comment writetotval(testlog, totval, env, envval,
string playername(increase(i)));
comment end;
if proposetest then writepropose;
end move;
\f
comment gomuko * page 4 19 03 81, 18.25
0 1 2 3 4 5 6 7 8 9 ;
procedure writemovetest(location, ij, depth);
value ij, depth;
integer ij, depth;
string location;
begin
write(testlog, <:<10>:>, case ((ij extract 1)+1) of (<:X:>, <:O:>),
location, false add 32, depth+1);
writefield(testlog, ij);
write(testlog, <: totval=:>);
writefieldval(testlog, ij);
end;
procedure writealphatest(actmover, depth, next, board,
newalpha, alpha, beta, bestmove);
value actmover, depth, next, board, newalpha, alpha, beta, bestmove;
integer actmover, depth, next, board, newalpha, alpha, beta, bestmove;
begin
write(testlog, <:<10>:>, case actmover of (<:X:>, <:O:>),
<: ALF:>, false add 32, depth+1, <:nx=:>);
writefield(testlog, next);
write(testlog, <: tv=:>);
writefieldval(testlog, next);
write(testlog, <: bv=:>, <<-ddd>, board, <<-ddd>,
<: na=:>, newalpha, <: al=:>, alpha, <: be=:>, beta, <: bm=:>);
writefield(testlog, bestmove);
end;
procedure writefield(outzone, ij);
value ij;
zone outzone;
integer ij;
begin
write(outzone, false add (ij//2//21+(if ij>378 then 65 else 64)),
1, <<dd>, ij//2 mod 21);
end;
procedure writefieldval(outzone, ij);
value ij;
zone outzone;
integer ij;
begin
boolean field pq;
pq:= ij;
write(outzone, <<ddd>, totval(pq) extract 14 shift (-7), <:,:>,
<<dd>, totval(pq) extract 7)
end;
\f
comment gomuko * page 5 19 03 81, 18.25
0 1 2 3 4 5 6 7 8 9 ;
procedure writenewboard;
begin
write(out, erase, 1, <: A B C D E F G H J K L M N O P Q R S T:>);
for i:= 1 step 1 until 19 do
write(out, down, 1, return, 1, <<dd>, 20-i,
<:. . . . . . . . . . . . . . . . . . .:>, 20-i);
write(out, down, 1, return, 1, <: A B C D E F G H J K L M N O P Q R S T:>);
setposition(out, 0, 0)
end;
procedure writehead(out);
zone out;
begin
write(out, xymode, 1, <:J:>, false, 1, <<dd dd dd>,
systime(2, gamestart, clock), <: :>, clock);
for mover:= 1, 2 do
begin
i:= 3*mover;
write(out, xymode, 1, <:J:>, false add (3*mover-2), 1,
case mover of (<:X :>, <:O :>),
string playername(increase(i)));
if playertype(mover)=1 then
begin
write(out, <: thr= :>, <<dd>, threatdepth(mover),
<:; slicefactor= :>, <<d.d>, slicefactor(mover), <:;:>,
<<d>, xymode, 1, <:T:>, false add(3*mover-1), 1,
<:str= :>, stratdepth(mover), <:; wid=:>);
for i:= 1 step 1 until stratdepth(mover)+1 do
write(out, <<dd>, width(mover, i));
write(out, <:;:>, xymode, 1, <:T:>, false add(3*mover), 1,
<:cre= :>, creative(mover, 4), <:+:>, creative(mover, 5), <:,:>,
creative(mover, 3), <:+:>, creative(mover, 2), <:;:>);
end
end;
write(out, xymode, 1, <:J<7>Moveno X O:>);
setposition(out, 0, 0)
end;
\f
comment gomuko * page 6 19 03 81, 18.25
0 1 2 3 4 5 6 7 8 9 ;
procedure writemoves(out, firstmove, lastmove);
value firstmove, lastmove;
integer firstmove, lastmove;
zone out;
begin
boolean field i;
for i:= firstmove step 1 until lastmove do
begin
write(out, xymode, 1, <:J:>, false add(8+i-firstmove), 1);
if i>0 then
begin
write(out, <<ddddd>, i, <: :>);
if i mod 2 = 0 then write(out, <: :>);
writefield(out, moves.i extract 10);
if i mod 2 = 1 then write(out, <: :>)
end
else
write(out, <: :>)
end;
setposition(out, 0, 0)
end;
\f
comment gomuko * page 7 19 03 81, 18.25
0 1 2 3 4 5 6 7 8 9 ;
procedure changeboard(lastmoveno, forward);
value lastmoveno, forward;
integer lastmoveno;
boolean forward;
begin
if forward then
begin
if lastmoveno>1 then changemove(lastmoveno-1, 1);
changemove(lastmoveno, 2)
end
else
begin
changemove(lastmoveno, 0);
changemove(lastmoveno-1, 2)
end;
setposition(out, 0, 0)
end;
procedure changemove(moveno, option);
value moveno, option;
integer moveno, option;
begin
boolean field m;
integer move, row, col, char, mover;
m:= moveno;
mover:= 2 - m mod 2;
move:= moves.m extract 10;
row:= 20-move//2 mod 21;
col:= move//2//21*2;
col:= if col>31 then col+32 else col+96;
char:= case option+1 of
(46, if mover=1 then 120 else 111,
if mover=1 then 88 else 79);
write(out, xymode, 1, false add col, 1, false add row, 1, false add char, 1)
end;
procedure writedetails(out);
zone out;
begin
write(out, xymode, 1, <:J<15>totval= :>);
writefieldval(out, bestmove);
write(out, <:; boardvalue=:>, <<-ddd>, boardvalue(mover), <: ;:>,
xymode, 1, <:J<16>movetime=:>, movetime,
<: s; totaltime= :>, timeused(moveno), <: s;:>);
if playertype(mover)=1 then
begin
write(out, xymode, 1, <:J<17>timeslice=:>, <<ddd>, timeslice(0),
<<-ddd>, <: s; alfa= :>, alpha, <: ;:>,
xymode, 1, <:J<18>nodes= :>, <<-dddd>, nodes,
<: ; nodetime=:>, (movetime-0.018*blocksread)/nodes*1000,
<: ms; :>, xymode, 1, <:J<19>blocksread=:>, <<ddd>, blocksread,
<: ;:>, xymode, 1, <:<96><22>:>);
for i:= 1 step 1 until threatdepth(mover) do
write(out, <<dddd>, node(i));
write(out, down, 1, return, 1);
for i:= 1 step 1 until threatdepth(mover) do
begin
write(out, <: :>);
writefield(out, bestseq(1, i));
end
end;
setposition(out, 0, 0)
end;
\f
comment gomuko * page 8 19 03 81, 18.25
0 1 2 3 4 5 6 7 8 9 ;
procedure writeboard(out, lastmoveno);
value lastmoveno;
integer lastmoveno;
zone out;
begin
procedure colnameline;
begin
write(out, <:<10> :>);
for col:= collow-margin step 1 until colhigh+margin do
if col>0 and col<20 then
begin
char:= if col>8 then col+65 else col+64;
write(out, false add char, 1)
end
end;
boolean array board(1:19, 1:19);
integer row, rowlow, rowhigh, col, collow, colhigh;
boolean field i;
for row:= 1 step 1 until 19 do
for col:= 1 step 1 until 19 do board(row, col):= false add 46;
rowlow:= collow:= 19;
rowhigh:= colhigh:= 1;
for i:= 1 step 1 until lastmoveno do
begin
row:= (moves.i extract 12)//2 mod 21;
col:= (moves.i extract 12)//2//21;
board(row, col):= false add (79+9*(i extract 1));
if i<lastmoveno then board(row, col):= board(row, col) add 32;
if row < rowlow then rowlow:= row;
if row > rowhigh then rowhigh:= row;
if col < collow then collow:= col;
if col > colhigh then colhigh:= col;
end i;
colnameline;
for row:= rowhigh+margin step -1 until rowlow-margin do
if row>0 and row<20 then
begin
write(out, <:<10>:>, <<dd>, row);
for col:= collow-margin step 1 until colhigh+margin do
if col>0 and col<20 then write(out, board(row, col), 1);
write(out, <<d>, row)
end row;
colnameline;
write(out, <:<10><10>:>);
end;
\f
comment gomuko * page 9 19 03 81, 18.25
0 1 2 3 4 5 6 7 8 9 ;
procedure writepropose;
begin
procedure writechain(totval);
value totval;
integer totval;
begin
boolean field pq;
write(testlog, <:<10>:>, <<ddd>, totval);
pq:= ij;
for pq:= propose(pq+1) shift (-1) while pq>0 and pq<1676 do
begin
write(testlog, <: :>);
writefield(testlog, pq shift (-1));
if totval<7 then writefieldval(testlog, pq shift (-1));
end
end;
boolean field ij;
integer player, prlow, i, j, pl;
for player:= 1, 2 do
begin
pl:= 2*player;
i:= mover*3;
write(testlog, <:<12>:>, string playername(increase(i)),
<:-propose for :>, case player of (<:X:>, <:O:>),
<:<10><10>trusler :<10>:>);
for ij:= 166+pl, 250+pl, 334+pl, 418+pl, 502+pl do
if propose(ij+1) < 3352 then writechain(7-ij//84);
write(testlog, <:<10><10>ikke-trusler :<10>:>);
prlow:= proposelow(mover, player)*4+1680;
for ij:= 2182+pl step -4 until prlow do
if propose(ij+1) < 3352 then writechain((ij-1676)//4);
comment
goto wpout;
write(testlog, <:<10><10><10> :>);
for i:= 0 step 1 until 20 do
write(testlog, <<ddd>, i);
write(testlog, <:<10>A . :>);
for ij:= 86+pl, ij+4 while ij<2188 do
begin
if ij mod 84 < 4 then
begin
write(testlog, <:<10>:>);
write(testlog, false add (ij//84
+(if ij//84 > 8 then 65 else 64)), 1, <: :>);
end;
if propose(ij+1) = 0 then
write(testlog, <: . :>)
else
writefield(testlog, propose(ij+1) shift (-2));
end;
wpout:
write(testlog, <:<10>:>);
end player;
end writepropose;
\f
comment gomuko * page 10 19 03 81, 18.25
0 1 2 3 4 5 6 7 8 9 ;
procedure discio(iotype);
value iotype;
integer iotype;
begin
real plnostring;
plnostring:= real ( case mover of (<:spiller1:>, <:spiller2:>));
disk(envval, -5, 6560, string plnostring, 0, iotype);
disk(totval, 0, 1762, string plnostring, 13, iotype);
disk(propose, 175, 4374, string plnostring, 17, iotype);
disk(env, 351, 6702, string plnostring, 26, iotype);
end;
procedure proposeclean(actmover);
value actmover;
integer actmover;
begin
integer fieldcount;
fieldcount:= 0;
ij:= 2186+actmover*2;
for ij:= ij-4
while (ij-1676) shift (-2) > proposelow(mover, actmover)
and fieldcount < enoughfields(mover) do
begin
pq:= ij;
for pq:= propose(pq+1) shift (-1) while pq<1676 do
fieldcount:= fieldcount+1;
end;
proposelow(mover, actmover):= (ij-1676) shift (-2);
pq:= ij;
for ij:= propose(ij+1) shift (-1) while ij>0 do
begin
propose(pq+1):= 0;
pq:= ij
end;
if proposetest then writepropose;
end;
\f
comment gomuko * page 11 19 03 81, 18.25
0 1 2 3 4 5 6 7 8 9 ;
procedure gameinit;
begin
moveblock:= 82;
winner:= 0;
moveno:= 0;
for mover:= 1, 2 do
begin
timeused(mover-2):= 0;
timeleft(mover-2):= if slicefactor(mover)>5 then 5000 else 950;
boardvalue(mover):= rowsum(mover):= colsum(mover):= 0;
if playertype(mover) = 1 then
begin
enoughfields(mover):= enoughfactor*width(mover, 1);
for i:= 1, 2 do proposelow(mover, i):= 0;
disk(env, 351, 6702, <:env:>, 0, 0);
i:= 3*mover;
disk(envval, -5, 6560, string playername(increase(i)), 0, 0);
i:= 3*mover;
disk(totval, 0, 1762, string playername(increase(i)), 13, 0);
for i:= 88 step 1 until 1679 do propose(i):= 0;
for i:= 2184 step -4 until 1680 do
begin
propose(i):= i+4;
propose(i+1):= i-4;
propose(i+2):= i+6;
propose(i+3):= i-2
end;
for i:= 169, 171, 253, 255, 337, 339, 421, 423, 505, 507 do propose(i):= 1676;
for i:= 88 step 1 until 2187 do propose(i):= 2*propose(i);
discio(1)
end;
end;
writenewboard;
writehead(out)
end;
\f
comment gomuko * page 12 19 03 81, 18.25
0 1 2 3 4 5 6 7 8 9 ;
procedure treatcommands;
begin
integer gotomoveno;
boolean testvalue;
repeatchar(in);
for i:= readchar(in, char) while char>31 do
if char = 63 and moveno=0 then
begin
comment forklaring til kommandoer;
write(out,<:
træk-syntax = A-T (ikke I) 1-19 (a-t tilladt)
kommandoer defaults
u n = margenbredde n 2
v n = n træk før diktat 150
w n = vinder nr. (0,1,2)
x n = gå tilbage til træk nr. n
y(-)p = enabler/disabler test-switches :
a = alfatest false
b = look ahead, 1 trin ad gangen false
c = movetest false
d = movedetails true
e = totvaltest false
f = proposetest false
g = envtest false
h = selecttest false
z = tom
komma efter kommandoer.
:>);
readchar(in, char);
setposition(out, 0, 0);
end
else
if char > 116 and char < 123 then
begin
if movedetails then
write(testlog, <:<10>kommando :>, false add char, 1);
case char-116 of
begin
begin
comment u;
read(in, margin)
end;
begin
comment v;
read(in, movegen);
if movedetails then write(testlog, movegen);
end;
begin
comment w;
read(in, winner);
winner:= winner+3;
goto game_end
end;
begin
comment x;
read(in, gotomoveno);
if gotomoveno <= moveno then
begin
gameinit;
moveno:= 1
end;
for moveno:= moveno step 1 until gotomoveno-1 do
begin
bestmove:= moves.moveno extract 10;
writemoves(out, moveno-mw, moveno);
changeboard(moveno, true);
for mover:= 1, 2 do
if playertype(mover) = 1 then
begin
discio(0);
if moveno<gotomoveno-1 or mover = 2-moveno mod 2 then
begin
move(bestmove, 1);
proposeclean(1+moveno mod 2)
end;
moveblock:= moveblock-1;
if moveblock<2 then moveblock:= 21;
discio(1)
end;
end;
moveno:= moveno-1;
goto movenostep
end;
begin
comment y;
readchar(in, char);
if movedetails then write(testlog, false add char, 1);
if char <> 45 then testvalue:= true
else
begin
testvalue:= false;
readchar(in, char);
if movedetails then write(testlog, false add char, 1);
end;
if char > 96 and char < 105 then
begin
case char-96 of
begin
alphatest:= testvalue;
lookaheadstep:= testvalue;
movetest:= testvalue;
movedetails:= testvalue;
totvaltest:= testvalue;
proposetest:= testvalue;
envtest:= testvalue;
selecttest:= testvalue;
end;
end;
end;
begin
comment z;
end;
end case char;
end;
end;
\f
comment gomuko * page 13 19 03 81, 18.25
0 1 2 3 4 5 6 7 8 9 ;
procedure input_move;
begin
input_start:
if movegen>0 and playertype(mover)=1 then
goto input_end;
writemoves(out, moveno-mw, moveno-1);
write(out, xymode, 1, <:J:>, false add(mw+8), 1,
<<ddddd>, moveno, false add 32, 10, back, 8);
if mover = 2 then write(out, <: :>);
write(out, <:?<8>:>);
setposition(out, 0, 0);
setposition(in, 0, 0);
i:=readchar(in, char);
if char>116 or i>6 then
begin
treatcommands;
goto input_start
end;
if char>96 then char:= char-32;
col:= if char>73 then char-65 else char-64;
read(in, row);
if row<1 or row>19 or col<1 or col>19 or char=73 then
begin
write(out, xymode, 1, <:J:>, false add (mw+9), 1, <: ???:>);
goto input_start
end;
bestmove:= (row+col*21)*2+mover-1;
pq:= bestmove+3-2*mover;
if totval(bestmove) < 16384
or totval(pq) < 16384 then
begin
write(out, xymode, 1, <:J:>, false add (mw+9), 1, <:feltet er besat:>);
goto input_start
end;
input_end:
write(out, xymode, 1, <:J:>, false add (mw+9), 1, false add 32, 15)
end;
\f
comment gomuko * page 14 19 03 81, 18.25
0 1 2 3 4 5 6 7 8 9 ;
procedure write_move(outzone, actmover, ownmove);
value actmover, ownmove;
integer actmover, ownmove;
zone outzone;
begin
write(outzone, <:<10>:>, <<ddd>, moveno-1+ownmove, <: :>);
if actmover=2 then write(outzone, <: :>);
writefield(outzone, bestmove);
if actmover=1 then write(outzone, <: :>);
if movedetails and playertype(mover)=1 then
begin
write(outzone, <: :>);
writefieldval(outzone, bestmove);
write(outzone, <<-ddddd>, boardvalue(mover));
if ownmove=1 then
begin
write(outzone, <<-ddddd>, alpha, blocksread, nodes,
<<-dddd.d>, (movetime-0.018*blocksread)/nodes*1000);
write(outzone, <<-ddd.d>, timeslice(0), <:<10> :>);
for i:= 1 step 1 until threatdepth(mover) do
write(outzone, <<dddd>, node(i));
write(outzone, <:<10> :>);
for i:= 1 step 1 until threatdepth(mover) do
begin
writefield(outzone, bestseq(1, i));
write(outzone, <: :>);
end;
end;
write(outzone, <:<10>:>)
end
end;
\f
comment gomuko * page 15 19 03 81, 18.25
0 1 2 3 4 5 6 7 8 9 ;
integer array totval(0:881),
propose(88:2187),
env(176:3351),
envval(-2:3280),
moves(1:75),
mnsub, od(1:2),
threat(1:63),
node(1:13),
bestseq(1:13, 1:13),
enoughfields, boardvalue,rowsum,colsum,
playertype, stratdepth, threatdepth, off, def(1:2),
creative(1:2, 2:5),
width(1:2, 1:13),
proposelow(1:2, 1:2),
cd(0:47);
real array slicefactor(1:2), timeleft, timeused(-1:150), playername(3:8),
answer(1:1), timebase, timeslice(0:13), slice(1:15, 1:15);
real gamestart, movestart, movetime, clock;
integer i, j, alpha, char, row, col, maxmoves, mover, margin, winner,
mw, moveblock, trywidth, stratval, stdepth, col1, row1, col2, row2,
balance, movegen, nodes, enoughfactor, bottomdivisor;
boolean array defense(-1:15);
boolean field ij, mn, pq, bestmove, moveno;
boolean alphatest, lookaheadstep, movetest, movedetails,
totvaltest, proposetest, envtest, selecttest, b,
xymode, back, down, erase, return, forward, up, home;
zone testlog(128, 1, stderror);
open(testlog, 4, <:testlog:>, 0);
begin
integer array ia(1:12);
getshare6(out, ia, 1);
ia(4):= logor(ia(4), 2);
setshare6(out, ia, 1)
end;
for ij:= 0 step 1 until 881 do totval(ij):= 16384;
maxmoves:= 150;
movegen:= maxmoves+1;
alphatest:= lookaheadstep:= movetest:= totvaltest:=
proposetest:= envtest:= selecttest:= false;
movedetails:= true;
margin:= 2;
defense(-1):= defense(0):= true;
for i:= 11 step 1 until 63 do threat(i):= 166;
for i:= 10, 9, 8, 7, 6, 5, 4 do threat(i):= 250;
threat(3):= 334;
threat(2):= 418;
threat(1):= 502;
for i:= 1 step 1 until 16 do
cd(i+31):= case i of (1, 9, 81, 729, 3, 27, 243, 2187,
-1, -9, -81, -729, -3, -27, -243, -2187);
for i:= 1 step 1 until 32 do
cd(i-1):= case i of
(-40, -80, -120, -160, 40, 80, 120, 160,
-42, -84, -126, -168, 42, 84, 126, 168,
-44, -88, -132, -176, 44, 88, 132, 176,
-2, -4, -6, -8, 2, 4, 6, 8);
for i:= 0 step 1 until 31 do cd(i):= 2*cd(i);
trywidth:= 15;
for i:= 1 step 1 until 15 do
begin
integer s, t;
s:= 1;
for t:= 2 step 1 until i do s:= s+t;
for j:= 1 step 1 until i do slice(i, j):= (i+1-j)/s
end;
col1:= 10;
row1:= 10;
col2:= 0;
row2:= 1;
timebase(0):= 0;
totval(0):= 0;
bestmove:= 440;
enoughfactor:= 3;
\f
comment gomuko * page 16 19 03 81, 18.25
0 1 2 3 4 5 6 7 8 9 ;
new_players:
for mover:= 1, 2 do
begin
write(out, <:<10><13>:>, case mover of (<:X:>, <:O:>), <: spillernavn= :>);
setposition(out, 0, 0);
setposition(in, 0, 0);
readstring(in, playername, mover*3);
mw:= 2;
xymode:= false add 6;
back:= false add 8;
down:= false add 10;
erase:= false add 12;
return:= false add 13;
forward:= false add 24;
up:= false add 26;
home:= false add 29;
threatdepth(mover):= stratdepth(mover):= 0;
if playername(3*mover) = real <:0:> then goto afslut;
if playername(3*mover) = real <:caesa:>add 114 then
begin
threatdepth(mover):= 11;
stratdepth(mover):= 6;
playertype(mover):= 1;
for j:= 1 step 1 until 13 do
width(mover, j):= case j of (6, 5, 4, 3, 3, 2, 0, 0, 0, 0, 0, 0, 0);
for j:= 2, 3, 4, 5 do
creative(mover, j):= case j-1 of (3, 33, 24, 3);
slicefactor(mover):= 2.4;
write(out, <:<10><13>defaults:<10><13>a : threatdepth .. :>, threatdepth(mover),
<:<10><13>b : stratdepth ... :>, stratdepth(mover),
<:<10><13>c : widths ....... :>);
for j:= 1 step 1 until stratdepth(mover)+1 do
write(out, <<ddd>, width(mover, j));
write(out, <:<10><13>d : crlimits ..... :>);
for j:= 4, 5, 3, 2 do write(out, <<ddd>, creative(mover, j));
write(out, <:<10><13>e : slicefactor .. :>, <<d.d>, slicefactor(mover));
if mover=1 then
write(out, <:<10><13>f : move1 ........:>, <<ddd>, col1, row1)
else
write(out, <:<10><13>f : move2 ........ :>, <<dd>, col2, row2);
write(out, <:<10><13>indtast eventuelle ændringer:<10><13>:>);
setposition(out, 0, 0);
setposition(in, 0, 0);
for i:= readchar(in, char) while char>96 and char<103 do
case char-96 of
begin
begin
read(in, threatdepth(mover))
end;
begin
read(in, stratdepth(mover))
end;
begin
for j:= 1 step 1 until stratdepth(mover)+1 do
read(in, width(mover, j))
end;
begin
for j:= 4, 5, 3, 2 do
read(in, creative(mover, j))
end;
begin
read(in, slicefactor(mover))
end;
begin
if mover=1 then
read(in, col1, row1)
else
read(in, col2, row2)
end;
end;
end
else
playertype(mover):= 2
end mover;
\f
comment gomuko * page 17 19 03 81, 18.25
0 1 2 3 4 5 6 7 8 9 ;
new_game:
moveno:= 0;
write(out, <:<10><13>kommandoer (u,v,w,x,y,z,?) :>);
setposition(out, 0, 0);
setposition(in, 0, 0);
readchar(in, char);
treatcommands;
systime(1, 0, gamestart);
gameinit;
for mover:= 1, 2 do
begin
off(mover):= def(mover):= stratdepth(mover);
if width(mover, stratdepth(mover)+1)<>0 then
begin
if stratdepth(mover) extract 1 = 1 then
def(mover):= def(mover)+1
else
off(mover):= off(mover)+1
end
end;
if movedetails then
begin
write(testlog, <:<12>:>, <<dd dd dd>,
systime(2, gamestart, clock), <: :>, clock);
for mover:= 1, 2 do
begin
i:= 3*mover;
write(testlog, case mover of (<:<10>X :>, <:<10>O :>),
string playername(increase(i)));
if playertype(mover) = 1 then
begin
write(testlog, <<ddd>, threatdepth(mover), stratdepth(mover), <:::>);
for i:= 1 step 1 until stratdepth(mover)+1 do
write(testlog, <<dd>, width(mover, i));
write(testlog, <:;:>, <<ddd>, creative(mover, 4),
creative(mover, 5), creative(mover, 3), creative(mover, 2));
end;
end;
write(testlog,<:<10>
Træk move total board blocks node time
nr. X O time time totval value alfa read nodes time slice
<10>:>);
end;
movenostep:
for moveno:= moveno+1 while moveno<=maxmoves and winner=0 do
begin
mover:= 2-moveno mod 2;
stdepth:= stratdepth(mover);
systime(1, 0, movestart);
blocksread:= 0;
for i:= 1 step 1 until 13 do node(i):= 0;
nodes:= 1;
moveblock:= moveblock-1;
if moveblock<2 then
begin
timeleft(moveno-2):= timeleft(moveno-2)+200;
timeleft(moveno-1):= timeleft(moveno-1)+200;
moveblock:= 21;
end;
alpha:= 0;
\f
comment gomuko * page 18 19 03 81, 18.25
0 1 2 3 4 5 6 7 8 9 ;
case playertype(mover) of
begin
begin
comment 1, intern spiller;
timeslice(0):= timeleft(moveno-2)/moveblock*slicefactor(mover)*2;
if timeslice(0)>timeleft(moveno-2) then
timeslice(0):= timeleft(moveno-2)/moveblock*2;
if playertype(3-mover)=1 then discio(0);
for i:= 1 step 1 until 13 do
for j:= 1 step 1 until 13 do bestseq(i, j):= 42;
if moveno=1 and movegen>0 then bestmove:= (col1*21+row1)*2
else
begin
if moveno > 1 then
begin
move(bestmove, 0);
if movedetails then
write_move(testlog, 3-mover, 0);
proposeclean(mover);
end;
stratval:= boardvalue(mover)*(3-2*mover);
balance:= stratval+totval(bestmove) extract 7 shift (-1);
if balance<0 then
begin
stdepth:= def(mover);
od(mover):= 3;
od(3-mover):= 0;
mnsub(mover):= 20;
mnsub(3-mover):= 20
end
else
begin
stdepth:= off(mover);
od(mover):= 0;
od(3-mover):= 3;
mnsub(mover):= 20;
mnsub(3-mover):= 20
end;
if movegen < 1 then input_move;
if movegen>0 then
begin
if moveno=2 then
begin
col:= bestmove//2//21;
row:= bestmove//2 mod 21;
comment i:= 1+round ((movestart-gamestart)*10) mod 3;
comment j:= case i of (0, 1, 1);
comment i:= case i of (1, 0, 1);
col:= col+(if col<10 then col2 else -col2);
row:= row+(if row<10 then row2 else -row2);
bestmove:= col*42+row*2+1;
end
else
begin
write(out, <:<6><96><21>:>, false add 32, 80, <:<26>:>);
alpha:= -alphabeta(1, -900, 900)
end
end
end;
if alpha<-900 then
begin
winner:= 3-mover;
write(out, <:<6><96><23><10><10>:>,
case mover of (<:X opgiver:>, <:O opgiver:>), <:<10><10>:>);
goto game_end
end;
move(bestmove, 1);
systime(1, movestart, movetime);
if movedetails then write_move(testlog, mover, 1);
proposeclean(3-mover);
if playertype(3-mover)=1 then discio(1)
end 1;
begin
comment 2, extern spiller;
input_move;
systime(1, movestart, movetime);
if movedetails then write_move(testlog, mover, 1);
end 2;
end case playertype;
moves.moveno:= false add bestmove;
writemoves(out, moveno-mw, moveno);
changeboard(moveno, true);
movegen:= movegen-1;
timeleft(moveno):= timeleft(moveno-2)-movetime;
timeused(moveno):= timeused(moveno-2)+movetime;
if movedetails then
begin
writedetails(out);
write(testlog,<:
:>, <<-dddd.d>, movetime, timeused(moveno), <:<10>:>);
writeboard(testlog, moveno);
end;
if totval(bestmove) extract 14 >= 11 shift 7 then winner:= mover
end moveno;
\f
comment gomuko * page 19 19 03 81, 18.25
0 1 2 3 4 5 6 7 8 9 ;
game_end:
write(out, <:<6><96><22><30>:>, false add 32, 52, <:<13><26>:>);
moveno:= moveno-1;
if winner >= 0 and winner <= 5 then
begin
write(out, case winner+1 of
(<:remis efter 150 træk:>,
<:X vinder:>,
<:O vinder:>,
<:spillet erklæret remis:>,
<:X erklæret vinder:>,
<:O erklæret vinder:>));
setposition(out, 0, 0);
if (winner=1 or winner=2) then
begin
if playertype(winner)=2 then
begin
write(out, <: Sejren skal kræves, ellers fortsætter spillet.:>,
<: Kræves den ? (ja/nej):>);
setposition(out, 0, 0);
setposition(in, 0, 0);
i:= 1;
readstring(in, answer, i);
if answer(1) = real <:nej:> then
begin
winner:= 0;
goto movenostep;
end
end;
end;
if movedetails then
write(testlog, <:<10><13><10><13>:>, case winner+1 of
(<:remis efter 150 træk:>,
<:X vinder:>,
<:O vinder:>,
<:spillet erklæret remis:>,
<:X erklæret vinder:>,
<:O erklæret vinder:>), <:<10><13>:>);
end
else winner:= 0;
\f
comment gomuko * page 20 19 03 81, 18.25
0 1 2 3 4 5 6 7 8 9 ;
begin
zone gamerec(128, 1, stderror);
boolean field bf, bf1;
integer field if1;
real field rf;
integer g, i;
open(gamerec, 4, <:gamerecords:>, 0);
if1:= 2;
swoprec6(gamerec, 2);
if gamerec.if1>99 then gamerec.if1:= 0;
g:= gamerec.if1:= gamerec.if1+1;
for i:= 1 step 1 until g do swoprec6(gamerec, 222);
for bf:= 1 step 1 until moveno do
gamerec.bf:= moves.bf;
bf:= 151;
gamerec.bf:= false add moveno;
bf:= 152;
gamerec.bf:= false add winner;
rf:= 156;
gamerec.rf:= gamestart;
for rf:= 160 step 4 until 180 do
gamerec.rf:= playername((rf-148)//4);
for mover:= 1, 2 do
begin
bf:= 168+18*mover;
gamerec.bf:= false add threatdepth(mover) shift 4 add stratdepth(mover);
for i:= 1 step 1 until threatdepth(mover) do
begin
bf:= 168+18*mover+i;
gamerec.bf:= false add width(mover, i)
end;
for i:= 2, 3, 4, 5 do
begin
bf:= 180+i+18*mover;
gamerec.bf:= false add creative(mover, i)
end
end;
close(gamerec, true)
end;
\f
comment gomuko * page 21 19 03 81, 18.25
0 1 2 3 4 5 6 7 8 9 ;
write(out,
<:<10><13>Flere spil med samme navne og parametre ? (ja/nej) :>);
setposition(out, 0, 0);
setposition(in, 0, 0);
i:= 1;
readstring(in, answer, i);
if answer(1) = real <:ja:> then
begin
movegen:= maxmoves+1;
write(out, <:<10><13>Skal der byttes om på X og O ? (ja/nej) :>);
setposition(out, 0, 0);
setposition(in, 0, 0);
i:= 1;
readstring(in, answer, i);
if answer(1) = real <:ja:> then
begin
real r;
for i:= 3, 4, 5 do
begin
r:= playername(i);
playername(i):= playername(i+3);
playername(i+3):= r;
end;
i:= playertype(1);
playertype(1):= playertype(2);
playertype(2):= i;
r:= slicefactor(1);
slicefactor(1):= slicefactor(2);
slicefactor(2):= r;
for j:= 2, 3, 4, 5 do
begin
i:= creative(1, j);
creative(1, j):= creative(2, j);
creative(2, j):= i
end;
i:= stratdepth(1);
stratdepth(1):= stratdepth(2);
stratdepth(2):= i;
i:= threatdepth(1);
threatdepth(1):= threatdepth(2);
threatdepth(2):= i;
for i:= 1 step 1 until 13 do
begin
j:= width(1, i);
width(1, i):= width(2, i);
width(2, i):= j
end;
end;
goto new_game
end;
write(out, <:<10><13>Flere spil med nye spillere ? (ja/nej) :>);
setposition(out, 0, 0);
setposition(in, 0, 0);
i:= 1;
readstring(in, answer, i);
if answer(1) = real <:ja:> then goto new_players;
afslut:
begin
integer array ia(1:12);
getshare6(out, ia, 1);
ia(4):= exor(ia(4), 2);
setshare6(out, ia, 1)
end;
write(testlog, <:<25>:>);
close(testlog, true)
end
end
end program
▶EOF◀