const
players=2;
x_pos=125;
res_x=5;
res_y=10;
kx=170;
ky=50;
prices_x=5;
prices_y=90;
trade_x=120;
trade_y=170;
buy_x=120;
buy_y=155;
end_x=120;
end_y=140;
tx=120;
ty=50;
px=100;
py=1;
type nodetype = record
f1,f2,f3,n1,n2,n3,owner,up,down:array[0..54] of byte;
x,y : array[0..54] of word;
end;
fieldtype = record
kind,number : array[1..37] of byte;
x,y : array[1..37] of word;
end;
roadtype = record
n1,n2,owner,up,down,xd,yd : array[1..75] of byte;
ofs,x,y : array[1..75] of word;
end;
karltype = record before,field:byte;
up,down : array[1..37] of byte;
end;
var node : nodetype;
field : fieldtype;
road : roadtype;
karl : karltype;
po : word;
j,key,lin : byte;
knights : array[0..3] of byte;
t : array[0..3,1..8] of byte;
trader : byte;
k_place : byte;
l,r : byte;
n : byte;
pic : word;
points : array[0..3] of byte;
size : word;
x,y : word;
first : byte;
player : byte;
rule : boolean;
ende : boolean;
dic : byte;
filename : string;
dseg : word;
bseg : word;
xseg : word;
p1,p2 : pointer;
desc : array[1..5] of byte;
crop : array[0..3,0..10] of byte;
s : array[1..200,1..320] of byte absolute $a000:0000;
buy0 : word;
buy1 : word;
desert : word;
end0 : word;
end1 : word;
erz1 : word;
erz2 : word;
erz3 : word;
erz4 : word;
erz5 : word;
house1 : word;
house2 : word;
house3 : word;
house4 : word;
karlpic : word;
lehm1 : word;
lehm2 : word;
lehm3 : word;
lehm4 : word;
lehm5 : word;
palette : word;
pig1 : word;
pig2 : word;
pig3 : word;
pig4 : word;
pig5 : word;
prices : word;
res : word;
road1 : word;
road2 : word;
road3 : word;
road4 : word;
road5 : word;
road6 : word;
road7 : word;
road8 : word;
road9 : word;
roada : word;
roadb : word;
roadc : word;
sheep1 : word;
sheep2 : word;
sheep3 : word;
sheep4 : word;
sheep5 : word;
tower1 : word;
tower2 : word;
tower3 : word;
tower4 : word;
trade0 : word;
trade1 : word;
water : word;
wood1 : word;
wood2 : word;
wood3 : word;
wood4 : word;
wood5 : word;
pixy : array[0..57000] of byte;
procedure plot(x,y,l,h,mem_pos:word);assembler;
{plot to screen}
label no_point,l1,l2;
asm
mov ax,$a000
mov es,ax
mov si,mem_pos
xor di,di
l2:
xor cx,cx
l1:
mov al,ds:[si]
cmp al,255
je no_point
push ax
mov bx,di
add bx,y
mov ax,320
mul bx
add ax,x
add ax,cx
mov bx,ax
pop ax
mov es:[bx],al
no_point:
inc si
inc cx
cmp cx,l
jne l1
inc di
cmp di,h
jne l2
end;
procedure dplot(x,y,l,h,mem_pos:word);assembler;
{plot to screen from 2nd pic buffer}
label no_point,l1,l2;
asm
push ds
mov ax,dseg
mov ds,ax
mov ax,$a000
mov es,ax
mov si,mem_pos
xor di,di
l2:
xor cx,cx
l1:
mov al,ds:[si]
cmp al,255
je no_point
push ax
mov bx,di
add bx,y
mov ax,320
mul bx
add ax,x
add ax,cx
mov bx,ax
pop ax
mov es:[bx],al
no_point:
inc si
inc cx
cmp cx,l
jne l1
inc di
cmp di,h
jne l2
pop ds
end;
procedure restore(x,y,l,h,base:word);assembler;
{plot from buffer segment}
label no_point,l1,l2;
asm
push ds
mov ax,bseg
mov ds,ax
mov ax,$a000
mov es,ax
mov si,base
xor di,di
l2:
xor cx,cx
l1:
mov al,ds:[si]
cmp al,255
je no_point
push ax
mov bx,di
add bx,y
mov ax,320
mul bx
add ax,x
add ax,cx
mov bx,ax
pop ax
mov es:[bx],al
no_point:
inc si
inc cx
cmp cx,l
jne l1
inc di
cmp di,h
jne l2
pop ds
end;
procedure change(x,y,l,h:word;f1,t1,f2,t2,f3,t3:byte);assembler;
{change pixels in a defined area - used as selector}
label no_point,l1,l2,no1,no2,no3;
asm
mov ax,$a000
mov es,ax
xor di,di
l2:
xor cx,cx
l1:
mov bx,di
add bx,y
mov ax,320
mul bx
add ax,x
add ax,cx
mov bx,ax
mov al,es:[bx]
cmp al,f1
jne no1
mov al,t1
mov es:[bx],al
no1:
cmp al,f2
jne no2
mov al,t2
mov es:[bx],al
no2:
cmp al,f3
jne no3
mov al,t3
mov es:[bx],al
no3:
inc si
inc cx
cmp cx,l
jne l1
inc di
cmp di,h
jne l2
end;
procedure generate_char(char:word;col:byte);assembler;
{generates a character in the buffer segment}
label mk0,mk1,mk2,mk3;
asm
push ds
mov ax,bseg
mov ds,ax
mov ax,char
shl ax,1
shl ax,1
shl ax,1
mov di,$fa6e
add di,ax
xor si,si
mov ax,$f000
mov es,ax
mov dl,8
mk0:
mov al,es:[di]
mov dh,8
mk1:
rcl al,1
jnc mk2
mov bl,col
mov ds:[si],bl
jmp mk3
mk2:
mov bl,255
mov ds:[si],bl
mk3:
inc si
dec dh
jnz mk1
inc di
dec dl
jnz mk0
pop ds
end;
procedure fnf;begin;writeln(filename,'not found!');halt;end;
function keypressed : boolean; assembler; asm
mov ah,0bh; int 21h; and al,0feh; end;
procedure WaitRetrace; assembler;
{ This waits for a vertical retrace to reduce snow on the screen }
label
l1, l2;
asm
mov dx,3DAh
l1:
in al,dx
and al,08h
jnz l1
l2:
in al,dx
and al,08h
jz l2
end;
Procedure Pal(Col,R,G,B : Byte); assembler;
{ This sets the Red, Green and Blue values of a certain color }
asm
mov dx,3c8h
mov al,[col]
out dx,al
inc dx
mov al,[r]
out dx,al
mov al,[g]
out dx,al
mov al,[b]
out dx,al
end;
Procedure GetPal(Col : Byte; Var R,G,B : Byte);
{ This gets the Red, Green and Blue values of a certain color }
Var
rr,gg,bb : Byte;
Begin
asm
mov dx,3c7h
mov al,col
out dx,al
add dx,2
in al,dx
mov [rr],al
in al,dx
mov [gg],al
in al,dx
mov [bb],al
end;
r := rr;
g := gg;
b := bb;
end;
procedure load;assembler;
label jo;
asm
mov ax,3d02h
mov dx,offset filename + 1
int 21h
jnc jo
jmp fnf
jo:
push ds
mov bx,ax
mov cx,size
mov dx,pic;
mov ax,xseg
mov ds,ax
mov ah,3fh
int 21h
pop ds
mov ah,$3e
int $21
end;
procedure load_pictures;
begin
xseg:=seg(buy0);
filename:='catan.1'+chr(0);
pic:=ofs(buy0);
size:=52000;
load;
po:=ofs(buy0);
xseg:=dseg;
filename:='catan.2'+chr(0);
pic:=0;
size:=60000;
load;
end;
procedure set_palette;assembler;
asm;mov ax,1012h;xor bx,bx;mov cx,255;mov dx,palette;add dx,po;int 10h;end;
procedure vga_mode;assembler;asm;mov ax,$13;int $10;end;
procedure text_mode;assembler;asm;mov ax,3;int $10;end;
procedure wait_key;assembler;asm;xor ax,ax;int $16;end;
procedure get_key;assembler;asm;xor ax,ax;int $16;mov key,ah;end;
procedure row(x,y,n:word);
var p,q,r:word;
a,i:byte;
begin
for i:=1 to n do
begin
field.x[j]:=x;
field.y[j]:=y;
pic:=desert+po;
case field.kind[j] of
0 : pic:=water+po;
1 : case field.number[j] of
1 : pic:=lehm1+po;
2 : pic:=lehm2+po;
3 : pic:=lehm3+po;
4 : pic:=lehm4+po;
5 : pic:=lehm5+po;
end;
2 : case field.number[j] of
1 : pic:=pig1+po;
2 : pic:=pig2+po;
3 : pic:=pig3+po;
4 : pic:=pig4+po;
5 : pic:=pig5+po;
end;
3 : case field.number[j] of
1 : pic:=wood1+po;
2 : pic:=wood2+po;
3 : pic:=wood3+po;
4 : pic:=wood4+po;
5 : pic:=wood5+po;
end;
4 : case field.number[j] of
1 : pic:=erz1+po;
2 : pic:=erz2+po;
3 : pic:=erz3+po;
4 : pic:=erz4+po;
5 : pic:=erz5+po;
end;
5 : case field.number[j] of
1 : pic:=sheep1+po;
2 : pic:=sheep2+po;
3 : pic:=sheep3+po;
4 : pic:=sheep4+po;
5 : pic:=sheep5+po;
end;
6 : pic:=karlpic+po;
7 : pic:=desert+po;
end;
plot(x,y,28,33,pic);
x:=x+28;
inc(j);
end;
end;
procedure k_connect;assembler;
asm
db 5,0,5,0,5,0
db 7,5,7,5,7,5,7,5,7,5,7,6
db 6,7,6,7,7,6,6,7,6,7,6,7,6,7
db 5,6,5,6,6,6,5,6,5,6,5,6
db 0,5,0,5,0,5,0,5,0,5
end;
procedure init_field;
var i,k:byte;
p:word;
begin
desc[1]:=3;desc[2]:=4;desc[3]:=4;desc[4]:=3;desc[5]:=4;
for i:=6 to 32 do field.kind[i]:=18;
field.kind[9]:=0;
field.kind[10]:=0;
field.kind[15]:=0;
field.kind[16]:=0;
field.kind[22]:=0;
field.kind[23]:=0;
field.kind[28]:=0;
field.kind[29]:=0;
field.kind[19]:=6;
karl.field:=19;
karl.before:=7;
p:=ofs(k_connect);
for j:=6 to 36 do
begin
karl.down[j]:=mem[seg(k_connect):p];
karl.up[j]:=mem[seg(k_connect):p+1];
inc(p,2);
end;
randomize;
for i:=1 to 37 do
if field.kind[i]=18 then
begin
repeat
k:=random(5)+1;
until desc[k]>0;
field.kind[i]:=k;
dec(desc[k]);
end;
for i:=6 to 32 do
begin
repeat k:=random(5)+1 until k<>7;
field.number[i]:=k;
end;
field.number[9]:=0;
field.number[10]:=0;
field.number[15]:=0;
field.number[16]:=0;
field.number[22]:=0;
field.number[23]:=0;
field.number[28]:=0;
field.number[29]:=0;
field.number[19]:=6;
for i:=0 to 54 do node.owner[i]:=18;
for i:=1 to 75 do road.owner[i]:=18;
end;
procedure make_field;
var i:byte;
adr: word;
begin
j:=1;
row(x_pos+42,0,4);
row(x_pos+28,27,5);
row(x_pos+14,54,6);
row(x_pos+0,81,7);
row(x_pos+14,108,6);
row(x_pos+28,135,5);
row(x_pos+42,162,4);
for i:=1 to 72 do if road.owner[i]<>18 then
plot(road.x[i],road.y[i],road.xd[i],road.yd[i],road.ofs[i]+road.owner[i]*504);
for i:=1 to 54 do if node.owner[i]<>18 then
if node.owner[i]<5 then
plot(node.x[i],node.y[i],18,17,house1+po+(node.owner[i]*306))
else plot(node.x[i]+2,node.y[i]-4,14,24,tower1+po+((node.owner[i]-10)*336))
end;
procedure save(x,y,l,h,base:word);
{move to buffer segment}
var p,q,r:word;
begin
r:=base;
for q:=1 to h do for p:=1 to l do
begin
mem[bseg:r]:=s[q+y,x+p];
inc(r);
end;
end;
procedure set_nodes(x,y,n,f,d,u:word);
begin
while n>0 do
begin
node.x[j]:=x;
node.y[j]:=y;
node.up[j]:=u;
node.down[j]:=d;
inc(j);
dec(n);
if f=1 then
begin
x:=x+14;
y:=y-4;
f:=0;
end
else
begin
x:=x+13;
y:=y+4;
f:=1;
end;
end;
end;
procedure abc(n,k,t:byte);
var i:byte;
begin
for i:=1 to n do
begin
node.f1[j]:=t;
node.f2[j]:=t+k;
node.f3[j]:=t+k+1;
inc(t);
inc(j,2);
end;
end;
procedure abc2(n,k,t:byte);
var i:byte;
begin
for i:=1 to n do
begin
node.f1[j]:=t;
node.f2[j]:=t+1;
node.f3[j]:=t+k;
inc(t);
inc(j,2);
end;
end;
function data(n:byte):word;
begin
data:=memw[dseg:n*2];
end;
procedure n_connect;assembler;
asm
db 0,2,9,1,3,0,2,4,11,3,5,0,4,6,13,5,7,0,6,0,15
db 0,9,18,8,10,1,9,11,20,10,12,3,11,13,22,12,14,5,13,15,24,14,16,7,15,0,26
db 0,18,28,17,19,8,18,20,30,19,21,10,20,22,32,21,23,12,22,24,34,23,25,14
db 24,26,36,25,27,16,26,0,38
db 0,29,17,28,30,39,29,31,19,30,32,41,31,33,21,32,34,43,33,35,23,34,36,45
db 35,37,25,36,38,47,37,0,27
db 0,40,29,39,41,48,40,42,31,41,43,50,42,44,33,43,45,52,44,46,35,45,47,54
db 46,0,37
db 0,49,40,48,50,0,49,51,42,50,52,0,51,53,44,52,54,0,53,0,46
end;
procedure r_connect;assembler;
asm
db 1,2,2,3,3,4,4,5,5,6,6,7
db 1,9,3,11,5,13,7,15
db 8,9,9,10,10,11,11,12,12,13,13,14,14,15,15,16
db 8,18,10,20,12,22,14,24,16,26
db 17,18,18,19,19,20,20,21,21,22,22,23,23,24,24,25,25,26,26,27
db 17,28,19,30,21,32,23,34,25,36,27,38
db 28,29,29,30,30,31,31,32,32,33,33,34,34,35,35,36,36,37,37,38
db 29,39,31,41,33,43,35,45,37,47
db 39,40,40,41,41,42,42,43,43,44,44,45,45,46,46,47
db 40,48,42,50,44,52,46,54
db 48,49,49,50,50,51,51,52,52,53,53,54
end;
procedure numbers;assembler;
asm
db 2,3,3,4,4,5,5,6,6,8,8,9,9,10,10,11,11,12
end;
procedure init_nodes;
var p:word;
begin
j:=1;
set_nodes(field.x[1]+5,field.y[1]+20,7,1,8,0);
set_nodes(field.x[5]+5,field.y[5]+20,9,1,10,8);
set_nodes(field.x[10]+5,field.y[10]+20,11,1,11,10);
set_nodes(field.x[16]+19,field.y[16]+16,11,0,10,11);
set_nodes(field.x[23]+19,field.y[23]+16,9,0,8,10);
set_nodes(field.x[29]+19,field.y[29]+16,7,0,0,8);
j:=1;
abc(4,4,1);
dec(j);
abc(5,5,5);
dec(j);
abc(6,6,10);
abc(5,6,17);
inc(j);
abc(4,5,24);
inc(j);
abc(3,4,30);
j:=2;
abc2(3,5,1);
dec(j);
abc2(5,6,4);
dec(j);
abc2(7,7,9);
abc2(5,7,17);
inc(j);
abc2(4,6,24);
inc(j);
abc2(3,5,30);
node.f2[7]:=node.f2[7]+4;
node.f3[7]:=node.f3[7]-2;
node.f2[16]:=node.f2[16]+4;
node.f3[16]:=node.f3[16]-1;
node.f1[39]:=23;
node.f2[39]:=24;
node.f3[39]:=29;
node.f1[48]:=29;
node.f2[48]:=30;
node.f3[48]:=34;
p:=ofs(n_connect);
for j:=1 to 54 do
begin
node.n1[j]:=mem[seg(n_connect):p];
node.n2[j]:=mem[seg(n_connect):p+1];
node.n3[j]:=mem[seg(n_connect):p+2];
inc(p,3);
end;
end;
procedure select_house;
var n:byte;
at_road:boolean;
label ocup;
begin
n:=1;
save(node.x[n],node.y[n],18,17,0);
plot(node.x[n],node.y[n],18,17,house1+po+(player*306));
ocup:
repeat
get_key;
case key of
1 : ende:=true;
77 : if n<54 then
begin
restore(node.x[n],node.y[n],18,17,0);
inc(n);
save(node.x[n],node.y[n],18,17,0);
plot(node.x[n],node.y[n],18,17,house1+po+(player*306));
end;
75 : if n>1 then
begin
restore(node.x[n],node.y[n],18,17,0);
dec(n);
save(node.x[n],node.y[n],18,17,0);
plot(node.x[n],node.y[n],18,17,house1+po+(player*306));
end;
80 : begin
restore(node.x[n],node.y[n],18,17,0);
n:=n+node.down[n];
if n>54 then n:=54;
save(node.x[n],node.y[n],18,17,0);
plot(node.x[n],node.y[n],18,17,house1+po+(player*306));
end;
72 : begin
restore(node.x[n],node.y[n],18,17,0);
n:=n-node.up[n];
if n=0 then n:=1;
save(node.x[n],node.y[n],18,17,0);
plot(node.x[n],node.y[n],18,17,house1+po+(player*306));
end;
end;
until ((key=28) and (node.owner[n]=18)) or (ende);
if (node.owner[node.n1[n]]<>18) and not ende then goto ocup;
if (node.owner[node.n2[n]]<>18) and not ende then goto ocup;
if (node.owner[node.n3[n]]<>18) and not ende then goto ocup;
if (not rule) and (not ende) then
begin
at_road:=false;
for j:=1 to 72 do
if ((road.n1[j]=n) or (road.n2[j]=n)) and (road.owner[j]=player)
then at_road:=true;
if not at_road then goto ocup;
end;
if not ende then
begin
node.owner[n]:=player;
inc(points[player]);
end;
if ende then restore(node.x[n],node.y[n],18,17,0);
first:=n;
end;
procedure select_tower;
var n:byte;
label no_house;
begin
n:=1;
save(node.x[n]+2,node.y[n]-4,14,24,0);
plot(node.x[n]+2,node.y[n]-4,14,24,tower1+po+(player*336));
no_house:
repeat
get_key;
case key of
1 : ende:=true;
77 : if n<54 then
begin
restore(node.x[n]+2,node.y[n]-4,14,24,0);
inc(n);
save(node.x[n]+2,node.y[n]-4,14,24,0);
plot(node.x[n]+2,node.y[n]-4,14,24,tower1+po+(player*336));
end;
75 : if n>1 then
begin
restore(node.x[n]+2,node.y[n]-4,14,24,0);
dec(n);
save(node.x[n]+2,node.y[n]-4,14,24,0);
plot(node.x[n]+2,node.y[n]-4,14,24,tower1+po+(player*336));
end;
80 : begin
restore(node.x[n]+2,node.y[n]-4,14,24,0);
n:=n+node.down[n];
if n>54 then n:=54;
save(node.x[n]+2,node.y[n]-4,14,24,0);
plot(node.x[n]+2,node.y[n]-4,14,24,tower1+po+(player*336));
end;
72 : begin
restore(node.x[n]+2,node.y[n]-4,14,24,0);
n:=n-node.up[n];
if n=0 then n:=1;
save(node.x[n]+2,node.y[n]-4,14,24,0);
plot(node.x[n]+2,node.y[n]-4,14,24,tower1+po+(player*336));
end;
end;
until (key=28) or (ende);
if (node.owner[n]<>player) and (not ende) then goto no_house;
if ende then restore(node.x[n]+2,node.y[n]-4,14,24,0);
if not ende then
begin
node.owner[n]:=player+10;
inc(points[player]);
end;
first:=n;
end;
procedure set_roads(x,y,n,f:word);
begin
while n>0 do
begin
road.x[j]:=x;
road.y[j]:=y;
road.xd[j]:=16;
road.yd[j]:=12;
dec(n);
if f=1 then
begin
x:=x+14;
f:=0;
road.ofs[j]:=road1+po;
end
else
begin
x:=x+14;
f:=1;
road.ofs[j]:=road2+po;
end;
inc(j);
end;
end;
procedure vert_roads(base,n:byte);
begin
road.x[j]:=field.x[base]+24;
road.y[j]:=field.y[base]+9;
road.xd[j]:=8;
road.yd[j]:=15;
road.ofs[j]:=road3+po;
while j<n do
begin
inc(j);
road.xd[j]:=8;
road.yd[j]:=15;
road.ofs[j]:=road3+po;
road.x[j]:=road.x[j-1]+28;
road.y[j]:=road.y[j-1];
end;
end;
procedure down_road_1(von,zu:byte);
var i:byte;
begin
i:=zu-von+1;
while von<zu do
begin
road.down[von]:=i;
road.down[von+1]:=i;
von:=von+2;
dec(i);
end;
end;
procedure down_road_2(von,zu:byte);
var i:byte;
begin
i:=zu-von+1;
while von<zu do
begin
road.down[von]:=i;
inc(von);
inc(i);
end;
end;
procedure down_road_3(von,zu:byte);
var i:byte;
begin
i:=zu-von+1;
while von<zu do
begin
road.down[von]:=i;
road.down[von+1]:=i-1;
von:=von+2;
dec(i);
end;
end;
procedure init_roads;
var i:byte;
p:word;
begin
j:=1;
set_roads(field.x[1]+12,field.y[1]+24,6,1);
vert_roads(5,11);
set_roads(field.x[5]+12,field.y[5]+24,8,1);
vert_roads(10,24);
set_roads(field.x[10]+12,field.y[10]+24,10,1);
vert_roads(16,40);
set_roads(field.x[16]+26,field.y[16]+24,10,0);
vert_roads(23,55);
set_roads(field.x[23]+26,field.y[23]+24,8,0);
vert_roads(29,67);
set_roads(field.x[29]+26,field.y[29]+24,6,0);
down_road_1(1,6);
down_road_2(7,11);
down_road_1(11,18);
down_road_2(19,23);
down_road_1(24,33);
down_road_2(34,39);
down_road_3(40,49);
down_road_2(50,54);
down_road_3(55,62);
down_road_2(63,66);
road.down[23]:=9;
road.down[39]:=10;
road.down[54]:=8;
road.down[66]:=6;
for i:=1 to 66 do road.up[i+road.down[i]]:=road.down[i];
for i:=7 to 72 do if road.up[i]=0 then road.up[i]:=road.up[i-1];
inc(road.up[33]);
p:=ofs(r_connect);
for j:=1 to 73 do
begin
road.n1[j]:=mem[seg(n_connect):p];
road.n2[j]:=mem[seg(n_connect):p+1];
inc(p,2);
end;
end;
procedure put_road;
begin
save(road.x[n],road.y[n],road.xd[n],road.yd[n],0);
plot(road.x[n],road.y[n],road.xd[n],road.yd[n],road.ofs[n]+(504*player));
end;
procedure select_road;
var il:boolean;
label illeg;
begin
n:=1;
save(road.x[n],road.y[n],16,12,0);
put_road;
illeg:
repeat
get_key;
case key of
77 : if n<72 then
begin
restore(road.x[n],road.y[n],road.xd[n],road.yd[n],0);
inc(n);
put_road;
end;
1 : ende:=true;
75 : if n>1 then
begin
restore(road.x[n],road.y[n],road.xd[n],road.yd[n],0);
dec(n);
put_road;
end;
80 : begin
restore(road.x[n],road.y[n],road.xd[n],road.yd[n],0);
n:=n+road.down[n];
put_road;
end;
72 : begin
restore(road.x[n],road.y[n],road.xd[n],road.yd[n],0);
n:=n-road.up[n];
put_road;
end;
end;
until ((key=28) and (road.owner[n]=18)) or (ende);
il:=true;
for j:=1 to 72 do
if road.owner[j]=player then
if (road.n1[j]=road.n1[n])
or (road.n2[j]=road.n2[n])
or (road.n1[j]=road.n2[n])
or (road.n2[j]=road.n1[n]) then il:=false;
{roads have to be connected to each others}
if ((node.owner[road.n1[n]]=player)
or (node.owner[road.n2[n]]=player))
then il:=false;
{roads have to be connected to houses... only first turn}
if il and not ende then goto illeg;
if not ende then road.owner[n]:=player;
if ende then restore(road.x[n],road.y[n],road.xd[n],road.yd[n],0);
end;
procedure ptext(txt:string;x,y:word;col:byte);
begin
for j:=1 to length(txt) do
begin
generate_char(ord(txt[j]),col);
restore(x,y,8,8,0);
x:=x+8;
end;
end;
procedure winner;
begin
ptext('HEY....',1,100,4);
ptext('GAME OVER!',1,110,4);
ptext('PLAYER '+chr(trader+ord('0'))+' WoN!!',1,120,4);
wait_key;
ende:=true;
end;
procedure show_res;
var yd,xd,k,p:word;
n,z:byte;
begin
plot(res_x,res_y,92,77,res+po);
for p:=0 to 3 do
for k:=1 to 5 do
begin
case k of
1 : yd:=11;
2 : yd:=23;
3 : yd:=47;
4 : yd:=59;
5 : yd:=35;
end;
case p of
0 : xd:=28;
1 : xd:=43;
2 : xd:=58;
3 : xd:=73;
end;
if crop[p,k]<10 then
begin
generate_char(ord('0')+crop[p,k],1);
if crop[p,k]<>0 then restore(res_x+xd,res_y+yd,8,8,0);
end
else
begin
generate_char(ord('0')+trunc(crop[p,k]/10),1);
restore(res_x+xd-4,res_y+yd,8,8,0);
generate_char(ord('0')+crop[p,k]-(trunc(crop[p,k]/10)*10),1);
restore(res_x+xd+3,res_y+yd,8,8,0);
end;
end;
z:=knights[0];
n:=6;
for j:=0 to 3 do if knights[j]>z then z:=knights[j];
for j:=0 to 3 do if (knights[j]=z) and (knights[j]>2) then n:=j;
if n<6 then
begin
dplot(res_x+28+(n*15),res_y+67,30,40,data(41));
inc(points[n],2);
end;
dplot(px,py,56,54,data(44));
if points[0]>0 then ptext(chr(points[0]+ord('0')),px+12,py+6,14);
if points[1]>0 then ptext(chr(points[1]+ord('0')),px+40,py+6,14);
if points[2]>0 then ptext(chr(points[2]+ord('0')),px+11,py+33,14);
if points[3]>0 then ptext(chr(points[3]+ord('0')),px+38,py+33,14);
for trader:=0 to players do if points[trader]>9 then winner;
end;
procedure firstest_turn;
begin
if not ende then select_house;
if not ende then select_road;
if not ende then make_field;
end;
procedure first_turn;
begin
if not ende then select_house;
if not ende then select_road;
if not ende then make_field;
inc(crop[player,field.kind[node.f1[first]]]);
inc(crop[player,field.kind[node.f2[first]]]);
inc(crop[player,field.kind[node.f3[first]]]);
if not ende then show_res;
end;
procedure show_num;
begin
for j:=1 to 34 do
begin
generate_char(ord('0')+field.number[j],18);
if field.kind[j]<>0
then restore(field.x[j]+1,field.y[j]+13,8,8,0);
end;
end;
procedure move_karl;
var n:byte;
begin
n:=6;
field.kind[karl.field]:=karl.before;
make_field;
save(field.x[n],field.y[n],28,33,0);
plot(field.x[n],field.y[n],28,33,karlpic+po);
repeat
get_key;
case key of
1 : ende:=true;
77 : if n<32 then
begin
restore(field.x[n],field.y[n],28,33,0);
inc(n);
while field.kind[n]=0 do inc(n);
save(field.x[n],field.y[n],28,33,0);
plot(field.x[n],field.y[n],28,33,karlpic+po);
end;
75 : if n>6 then
begin
restore(field.x[n],field.y[n],28,33,0);
dec(n);
while field.kind[n]=0 do dec(n);
save(field.x[n],field.y[n],28,33,0);
plot(field.x[n],field.y[n],28,33,karlpic+po);
end;
80 : begin
restore(field.x[n],field.y[n],28,33,0);
n:=n+karl.down[n];
save(field.x[n],field.y[n],28,33,0);
plot(field.x[n],field.y[n],28,33,karlpic+po);
end;
72 : begin
restore(field.x[n],field.y[n],28,33,0);
n:=n-karl.up[n];
save(field.x[n],field.y[n],28,33,0);
plot(field.x[n],field.y[n],28,33,karlpic+po);
end;
end;
until (key=28) or (ende);
karl.field:=n;
karl.before:=field.kind[n];
field.kind[n]:=6;
make_field;
end;
procedure harvest;
var f,n:byte;
begin
dic:=random(6)+1;
write(^m,'P',player,' D',dic,' ');
if dic=6 then move_karl;
for f:=1 to 36 do if field.number[f]=dic then
for n:=1 to 54 do
begin
if (node.f1[n]=f) and (node.owner[n]<>18)
then if node.owner[n]<10 then
inc(crop[node.owner[n],field.kind[node.f1[n]]])
else inc(crop[node.owner[n]-10,field.kind[node.f1[n]]],2);
if (node.f2[n]=f) and (node.owner[n]<>18)
then if node.owner[n]<10 then
inc(crop[node.owner[n],field.kind[node.f2[n]]])
else inc(crop[node.owner[n]-10,field.kind[node.f2[n]]],2);
if (node.f3[n]=f) and (node.owner[n]<>18)
then if node.owner[n]<10 then
inc(crop[node.owner[n],field.kind[node.f3[n]]])
else inc(crop[node.owner[n]-10,field.kind[node.f3[n]]],2);
end;
show_res;
end;
procedure blink;
var bf,k:byte;
pic:word;
label oekel,erol;
begin
bf:=0;
repeat
for j:=1 to 36 do if field.number[j]=dic then
begin
pic:=0;
case field.kind[j] of
1 : pic:=lehm1+po;
2 : pic:=pig1+po;
3 : pic:=wood1+po;
4 : pic:=erz1+po;
5 : pic:=sheep1+po;
end;
pic:=pic+(bf*924);
if pic>0 then plot(field.x[j],field.y[j],28,33,pic);
end;
inc(bf);
if bf=4 then bf:=0;
j:=0;
repeat
if keypressed then
begin
get_key;
ende:=true;
end;
inc(j);
until (ende) or (j=50);
until ende;
ende:=false;
end;
procedure show_knights;
var u,w:byte;
begin
save(kx,ky,86,63,(114*100)+(26*80));
dplot(kx,ky,86,63,data(43));
x:=kx+10;y:=ky+10;
for w:=0 to 3 do
for u:=1 to knights[w] do dplot(x+((u-1)*7),y+(w*12),8,8,data(42));
wait_key;
restore(kx,ky,86,63,(114*100)+(26*80));
end;
procedure buy;
var pos:byte;
label lamer;
begin
save(prices_x,prices_y,114,100,26*80);
plot(prices_x,prices_y,114,100,prices+po);
pos:=1;
save(prices_x+10,prices_y+10,26,80,0);
lamer:
repeat
restore(prices_x+10,prices_y+10,26,80,0);
if pos=1 then change(prices_x+10,prices_y+10,26,14,$b9,1,$b7,1,$b5,1);
{road}
if pos=2 then change(prices_x+10,prices_y+25,26,18,$b9,1,$b7,1,$b5,1);
{house}
if pos=3 then change(prices_x+10,prices_y+43,26,25,$b9,1,$b7,1,$b5,1);
{tower}
if pos=4 then change(prices_x+10,prices_y+68,26,22,$40,1,$40,1,$40,1);
{research}
get_key;
case key of
80 : begin;inc(pos);if pos=5 then pos:=1;end;
72 : begin;dec(pos);if pos=0 then pos:=4;end;
1 : ende:=true;
end;
until (key=28) or ende;
restore(prices_x+10,prices_y+10,26,80,0);
if not ende then case pos of
1 : if (crop[player,1]>0) and (crop[player,3]>0) then
begin
select_road;
if not ende then
begin
dec(crop[player,1]);
dec(crop[player,3]);
end;
show_res;
make_field;
restore(prices_x,prices_y,114,100,26*80);
end
else goto lamer;
2 : if (crop[player,1]>0) and (crop[player,2]>0)
and (crop[player,3]>0) and (crop[player,5]>0) then
begin
select_house;
if not ende then
begin
dec(crop[player,1]);
dec(crop[player,2]);
dec(crop[player,3]);
dec(crop[player,5]);
end;
make_field;
restore(prices_x,prices_y,114,100,26*80);
show_res;
end
else goto lamer;
3 : if (crop[player,2]>1) and (crop[player,4]>2) then
begin
select_tower;
if not ende then
begin
dec(crop[player,2],2);
dec(crop[player,4],3);
end;
make_field;
restore(prices_x,prices_y,114,100,26*80);
show_res;
end
else goto lamer;
4 : if (crop[player,2]>0) and (crop[player,4]>0) and (crop[player,5]>0)
then begin
dec(crop[player,2]);
dec(crop[player,4]);
dec(crop[player,5]);
inc(knights[player]);
restore(prices_x,prices_y,114,100,26*80);
show_knights;
show_res;
end
else goto lamer;
end;
if ende then restore(prices_x,prices_y,114,100,26*80);
ende:=false;
end;
procedure ptrade;
var i:byte;
begin
x:=tx+93;
y:=ty+61;
restore(tx+93,ty,12,70,64);
for i:=1 to r do
begin
if t[player,i]=4 then dplot(x,y,8,5,data(35)); {erz}
if t[player,i]=1 then dplot(x,y,10,6,data(36)); {lehm}
if t[player,i]=2 then dplot(x,y,10,6,data(37)); {pig}
if t[player,i]=5 then dplot(x,y,12,7,data(38)); {sheep}
if t[player,i]=3 then dplot(x,y,10,7,data(39)); {wood}
y:=y-8;
end;
x:=tx+59;
y:=ty+61;
restore(tx+59,ty,12,70,70*12+64);
for i:=1 to l do
begin
if t[trader,i]=4 then dplot(x,y,8,5,data(35)); {erz}
if t[trader,i]=1 then dplot(x,y,10,6,data(36)); {lehm}
if t[trader,i]=2 then dplot(x,y,10,6,data(37)); {pig}
if t[trader,i]=5 then dplot(x,y,12,7,data(38)); {sheep}
if t[trader,i]=3 then dplot(x,y,10,7,data(39)); {wood}
y:=y-8;
end;
save(tx+18,ty+60,130,20,70*24+64);
end;
procedure tscr;
begin
dplot(tx,ty,161,94,data(40)); {trade-screen}
dplot(tx+115,ty+60,8,5,data(35)); {erz}
dplot(tx+125,ty+60,10,6,data(36)); {lehm}
dplot(tx+135,ty+60,10,6,data(37)); {pig}
dplot(tx+114,ty+70,12,7,data(38)); {sheep}
dplot(tx+126,ty+70,10,7,data(39)); {wood}
dplot(tx+18,ty+60,8,5,data(35)); {erz}
dplot(tx+28,ty+60,10,6,data(36)); {lehm}
dplot(tx+38,ty+60,10,6,data(37)); {pig}
dplot(tx+17,ty+70,12,7,data(38)); {sheep}
dplot(tx+29,ty+70,10,7,data(39)); {wood}
ptext(chr(player+ord('0')),tx+110,ty+40,12);
ptext(chr(trader+ord('0')),tx+47,ty+40,12);
ptext('OK',tx+73,ty+30,7);
ptext(chr(27)+chr(26),tx+73,ty+20,7);
generate_char(27,7);
restore(tx+137,ty+70,8,8,0);
restore(tx+40,ty+70,8,8,0);
end;
procedure trade;
var pos:integer;
begin
pos:=1;
r:=1;
l:=1;
trader:=1;
if trader=player then inc(trader);
if trader>players then trader:=0;
for x:=0 to 3 do for y:=1 to 8 do t[x,y]:=0;
save(tx,ty,161,94,20*130+70*24+64);
tscr;
save(tx+93,ty,12,70,64);
save(tx+59,ty,12,70,70*12+64);
save(tx+18,ty+60,130,20,70*24+64);
repeat
repeat
restore(tx+18,ty+60,130,20,70*24+64);
if pos=1 then change(tx+115,ty+60,8,5,$48,1,$49,1,$4a,1);
if pos=2 then change(tx+125,ty+60,10,6,$d4,1,$dc,1,$40,1);
if pos=3 then change(tx+135,ty+60,10,6,$31,1,$32,1,$33,1);
if pos=4 then change(tx+114,ty+70,12,7,$11,1,$12,1,$10,1);
if pos=5 then change(tx+126,ty+70,10,7,$d9,1,$e0,1,$de,1);
if pos=6 then change(tx+137,ty+70,8,8,7,1,7,1,7,1);
if pos=7 then change(tx+18,ty+60,8,5,$48,1,$49,1,$4a,1);
if pos=8 then change(tx+28,ty+60,10,6,$d4,1,$dc,1,$40,1);
if pos=9 then change(tx+38,ty+60,10,6,$31,1,$32,1,$33,1);
if pos=10 then change(tx+17,ty+70,12,7,$11,1,$12,1,$10,1);
if pos=11 then change(tx+29,ty+70,10,7,$d9,1,$e0,1,$de,1);
if pos=12 then change(tx+40,ty+70,8,8,7,1,7,1,7,1);
if pos=13 then change(tx+73,ty+30,16,8,7,1,7,1,7,1);
if pos=14 then change(tx+73,ty+20,16,8,7,1,7,1,7,1);
get_key;
case key of
80 : begin
if pos=13 then
begin
pos:=-2;
change(tx+72,ty+30,16,8,1,7,1,7,1,7);
end;
if (pos<7) and (pos>3) then dec(pos,3);
if (pos<13) and (pos>9) then dec(pos,3);
if pos=14 then
begin
pos:=10;
change(tx+72,ty+20,16,8,1,7,1,7,1,7);
end;
inc(pos,3);
if pos>13 then pos:=13;
end;
72 : begin
if pos=13 then
begin
change(tx+72,ty+30,16,8,1,7,1,7,1,7);
pos:=17;
end;
if pos=14 then
begin
pos:=17;
change(tx+72,ty+20,16,8,1,7,1,7,1,7);
end;
if (pos<4) and (pos>0) then pos:=16;
if (pos<10) and (pos>6) then pos:=16;
dec(pos,3);
if pos<1 then pos:=1;
end;
77 : begin
if pos=13 then
begin
pos:=0;
change(tx+72,ty+30,16,8,1,7,1,7,1,7);
end;
if pos=14 then
begin
pos:=12;
change(tx+72,ty+20,16,8,1,7,1,7,1,7);
end;
if pos=3 then dec(pos);
if pos=12 then pos:=3;
inc(pos);
if pos=7 then pos:=6;
if pos=10 then pos:=1;
end;
75 : begin
if pos=13 then
begin
pos:=2;
change(tx+72,ty+30,16,8,1,7,1,7,1,7);
end;
if pos=14 then
begin
change(tx+72,ty+20,16,8,1,7,1,7,1,7);
end;
if pos=4 then pos:=13;
if pos=7 then inc(pos);
if pos=10 then inc(pos);
dec(pos);
if pos=0 then pos:=9;
end;
1 : ende:=true;
end;
until (key=28) or ende;
restore(tx+18,ty+60,130,20,70*24+64);
if (pos=6) and (not ende) then if r>1 then
begin
dec(r);
inc(crop[player,t[player,r]]);
show_res;
t[player,r]:=0;
ptrade;
end;
if (pos=12) and (not ende) then if l>1 then
begin
dec(l);
inc(crop[trader,t[trader,l]]);
show_res;
t[trader,l]:=0;
ptrade;
end;
if (pos<6) and (r<8) and (not ende) then
begin
if (pos=1) and (crop[player,4]>0) then
begin;t[player,r]:=4;dec(crop[player,4]);show_res;inc(r);ptrade;end;
if (pos=2) and (crop[player,1]>0) then
begin;t[player,r]:=1;dec(crop[player,1]);show_res;inc(r);ptrade;end;
if (pos=3) and (crop[player,2]>0) then
begin;t[player,r]:=2;dec(crop[player,2]);show_res;inc(r);ptrade;end;
if (pos=4) and (crop[player,5]>0) then
begin;t[player,r]:=5;dec(crop[player,5]);show_res;inc(r);ptrade;end;
if (pos=5) and (crop[player,3]>0) then
begin;t[player,r]:=3;dec(crop[player,3]);show_res;inc(r);ptrade;end;
end;
if (pos>6) and (pos<12) and (l<8) and (not ende) then
begin
if (pos=7) and (crop[trader,4]>0) then
begin;t[trader,l]:=4;dec(crop[trader,4]);show_res;inc(l);ptrade;end;
if (pos=8) and (crop[trader,1]>0) then
begin;t[trader,l]:=1;dec(crop[trader,1]);show_res;inc(l);ptrade;end;
if (pos=9) and (crop[trader,2]>0) then
begin;t[trader,l]:=2;dec(crop[trader,2]);show_res;inc(l);ptrade;end;
if (pos=10) and (crop[trader,5]>0) then
begin;t[trader,l]:=5;dec(crop[trader,5]);show_res;inc(l);ptrade;end;
if (pos=11) and (crop[trader,3]>0) then
begin;t[trader,l]:=3;dec(crop[trader,3]);show_res;inc(l);ptrade;end;
end;
if pos=14 then
begin
for j:=1 to 8 do
if t[trader,j]>0 then inc(crop[trader,t[trader,j]]);
show_res;
for j:=1 to 8 do t[trader,j]:=0;
repeat
inc(trader);
if trader>players then trader:=0;
until (trader<>player);
tscr;
l:=1;
ptrade;
ptext(chr(player+ord('0')),tx+110,ty+40,12);
ptext(chr(trader+ord('0')),tx+47,ty+40,12);
end;
until (ende) or (pos=13);
restore(tx,ty,161,94,2600+70*24+64);
if not ende then
begin
for j:=1 to 8 do
if t[player,j]>0 then inc(crop[trader,t[player,j]]);
for j:=1 to 8 do
if t[trader,j]>0 then inc(crop[player,t[trader,j]]);
show_res;
end;
if ende then
begin
for j:=1 to 8 do
if t[player,j]>0 then inc(crop[player,t[player,j]]);
for j:=1 to 8 do
if t[trader,j]>0 then inc(crop[trader,t[trader,j]]);
show_res;
end;
ende:=false;
end;
procedure commands;
var pos:byte;
begin
pos:=3;
repeat
save(end_x,end_y,26,41,0);
repeat
restore(end_x,end_y,26,41,0);
if pos=1 then plot(buy_x,buy_y,18,11,buy1+po)
else plot(buy_x,buy_y,18,11,buy0+po);
if pos=2 then plot(trade_x,trade_y,26,11,trade1+po)
else plot(trade_x,trade_y,26,11,trade0+po);
if pos=3 then plot(end_x,end_y,18,11,end1+po)
else plot(end_x,end_y,18,11,end0+po);
get_key;
case key of
80 : begin;inc(pos);if pos=4 then pos:=1;end;
72 : begin;dec(pos);if pos=0 then pos:=3;end;
48 : begin;pos:=1;key:=28;end;
20 : begin;pos:=2;key:=28;end;
18 : begin;pos:=3;key:=28;end;
37 : show_knights;
1 : ende:=true;
end;
until (key=28) or ende;
restore(end_x,end_y,26,41,0);
case pos of
2 : if not ende then trade;
1 : if not ende then buy;
end;
until (pos=3) or (ende);
restore(end_x,end_y,26,41,0);
end;
begin
getmem(p1,60000);
dseg:=seg(p1^);
getmem(p2,60000);
bseg:=seg(p2^);
load_pictures;
vga_mode;
set_palette;
init_field;
make_field;
init_nodes;
init_roads;
show_res;
rule:=true;
for player:=0 to players do firstest_turn;
for player:=players downto 0 do first_turn;
rule:=false;
repeat
for player:=0 to players do if not ende then
begin
harvest;
commands;
end;
until ende;
text_mode;
end.