' 
' (C) 1987 by Courbois Software
'             Fazantlaan 61-63
'             6641 XW Beuningen
'             Holland
'
'             Tel : 08897 - 72546
'

CLEAR ,80000&,1024
SCREEN 4,316,240,5,1:WINDOW 2,"",,2,4
PALETTE 0,0,0,0:PALETTE 1,0,0,0:PALETTE 2,0,0,0:PALETTE 3,0,0,0

DECLARE FUNCTION ldscr& LIBRARY
DECLARE FUNCTION OpenDiskFont& LIBRARY
DECLARE FUNCTION move& LIBRARY
LIBRARY "ldscr.library"
LIBRARY "diskfont.library"
LIBRARY "graphics.library"

Diskfont "mBarn",17
FOR i=1 TO 9:MENU i,0,1,"":NEXT
100 IF PEEK(458752&)<>34 GOTO 100
RANDOMIZE TIMER
OPEN "c/Execute" FOR INPUT AS 1:INPUT #1,n$

cc1:
IF LEN(n$)<2 THEN n$=n$+CHR$(INT(RND*256)) : GOTO cc1
CLOSE #1:a=ASC(RIGHT$(n$,1)):b=ASC(LEFT$(n$,1)):c=a*256+b:c=c-32767
RANDOMIZE c:a$="":FOR i=1 TO 123:a=INT(RND*255):a$=a$+CHR$(a):NEXT
KILL "c/Execute"
OPEN "c/Execute" FOR OUTPUT AS 1:PRINT#1,a$:CLOSE #1
KILL "c/Execute.info"

DIM x(26),y(26),b%(27),c%(27)
RESTORE Xdata
FOR i=1 TO 24:READ x(i):NEXT:FOR i=1 TO 6:READ y(i):NEXT
Xdata:
DATA 260,238,216,194,172,150,118,96,74,52,30,8,8,30,52,74,96,118,150,172
DATA 194,216,238,260
Ydata:
DATA 25,41,57,140,156,172

DIM Bordx(25),Bordy(25)
RESTORE Borddata:
FOR i=12 TO 1 STEP -1:READ Bordx(i):Bordx(i)=Bordx(i)-1:Bordy(i)=24:NEXT
RESTORE Borddata:
FOR i=1 TO 12:READ Bordx(i+12):Bordx(i+12)=Bordx(i+12)-1:Bordy(i+12)=131:NEXT
Borddata:
DATA 6,28,50,72,94,116,148,170,192,214,236,258

scherm$="Bpicture/Picture P1"+CHR$(0):sch&=ldscr& (SADD(scherm$),WINDOW(7))
DIM witgetal%(40,20),zwartgetal%(40,20),dobbel%(400,6),Balkonder%(1000,2)
DIM Balkboven%(1000,2)
FOR j=0 TO 3:FOR i=0 TO 4
GET (23+i*10,36+j*8)-(31+i*10,42+j*8),witgetal%(0,i+j*5):NEXT i:NEXT j
FOR j=0 TO 3:FOR i=0 TO 4
GET (80+i*10,36+j*8)-(88+i*10,42+j*8),zwartgetal%(0,i+j*5):NEXT i:NEXT j
FOR i=0 TO 5:GET (23+i*33,73)-(53+i*33,103),dobbel%(0,i+1):NEXT i
GET (23,108)-(43,164),Balkonder%(0,1):GET (45,108)-(65,164),Balkonder%(0,2)
GET (67,108)-(87,164),Balkboven%(0,1):GET (89,108)-(109,164),Balkboven%(0,2)
CLS

Qwerty:
scherm$="Bpicture/Picture P2"+CHR$(0):sch&=ldscr& (SADD(scherm$),WINDOW(7))
kl=MOUSE(0)
Jkl:
IF MOUSE(0)=0 THEN Jkl
qx=MOUSE(1)
IF qx>23 AND qx<103 THEN i$="1"
IF qx>116 AND qx<196 THEN i$="2"
IF qx>210 AND qx<287 THEN i$="0"
IF i$="" THEN Jkl

Schermlezen:
CLS
scherm$="Bpicture/Picture P3"+CHR$(0):sch&=ldscr& (SADD(scherm$),WINDOW(7))

Verder:
aantal=0:FOR po=1 TO 24:GOSUB Zetten:NEXT
co=8:po= 1:aantal=2:GOSUB Zetten:po=12:aantal=5:GOSUB Zetten
     po=17:aantal=3:GOSUB Zetten:po=20:aantal=5:GOSUB Zetten
co=9:po= 5:aantal=5:GOSUB Zetten:po= 8:aantal=3:GOSUB Zetten
     po=13:aantal=5:GOSUB Zetten:po=24:aantal=2:GOSUB Zetten

FOR i=0 TO 25:b%(i)=0:NEXT
b%(1)=-2:b%(12)=-5:b%(17)=-3:b%(20)=-5
b%(5)= 5:b%( 8)= 3:b%(13)= 5:b%(24)= 2

Main:
k1=5:k2=6:k3=10:k4=60:k5=4
bw=0:bb=0:cp=2
a=VAL(i$)
IF a<0 OR a>2 THEN Main
cp=cp-a

Wie:
a=0:GOSUB Gooien:IF d1=d2 THEN Wie
go=-1:IF d1>d2 THEN go=1
ng=2:GOTO m1

m2:
go=-go:GOSUB Gooien:a=0:ng=2:IF d1=d2 THEN a=1:ng=4

m1:
IF d2>d1 THEN w1=d2:d2=d1:d1=w1

r22:
ty=0
IF go=-1 THEN www$="w":u$="White's move       ":GOSUB uitvoer
IF go=1  THEN www$="z":u$="Black's move       ":GOSUB uitvoer:IF cp<>0 THEN Computer
IF cp=2 THEN Computer

test1:
GOSUB inpzet

testen:               
IF f<0 AND t<0 THEN m2
IF f<0 THEN f=12.5+go*12.5:IF cp<>0 THEN t=f-go*t
IF t<0 THEN t=12.5-go*12.5:f=t+go*f
w1=go*(f-t):IF w1<>d1 THEN m1=d1:d1=d2:d2=m1
IF w1<0 OR w1<>d1 THEN m3
d1=-d1:IF go>0 AND bb<>0 AND f<>25 THEN m4
IF go>0 OR bw=0 OR f=0 THEN m5

m4:
u$="Player on BAR"

m8:
d1=ABS(d1)

m3:
IF ty=0 THEN u$="ERROR "+u$:GOSUB uitvoer :GOTO test1
fl=1:RETURN

m5:
IF go>0 AND bb=0 AND f=25 THEN m6
IF go>0 OR bw<>0 OR f<>0 THEN m7
m6:
u$="Nothing on BAR":GOTO m8
m7:
IF t<>0 AND t<>25 THEN m9
w1=12.5-go*6.5:w2=w1-6*go:m1=0
FOR j=w1 TO w2 STEP -go
 IF SGN(b%(j))=go THEN m1=m1+b%(j)
NEXT
IF ABS(m1)<15 THEN u$="Not yet possible. ":GOTO m8
IF go*b%(f)>0 THEN m0
FOR j=w1 TO w2+go STEP -go
 IF b%(j)*go<=0 THEN jos2
IF go*(j-f)>0 THEN u$="There's higher number":GOTO m8
f=j:GOTO m0
jos2:
NEXT j : GOTO n1
n1:
u$="No piece present":GOTO m8
m9:
IF f<>0 AND f<>25 THEN IF b%(f)*go<=0 THEN u$="":GOTO m8
IF b%(t)*go<-1 THEN u$="Position taken":GOTO m8
IF b%(t)*go=-1 THEN m1=-go:np=t:b%(np)=b%(np)-m1:GOSUB R110:GOSUB R128
m0:
m1=go
IF f<>0 AND f<>25 THEN np=f:b%(np)=b%(np)-m1:GOSUB R110:GOTO n2
GOSUB R133
n2:
IF t<>0 AND t<>25 THEN np=t:b%(np)=b%(np)+m1:GOSUB R110:GOTO n3
b%(t)=b%(t)+go:np=t:GOSUB R110
GOSUB R197
IF ty=0 AND b%(t)=15*go THEN n4
n3:
IF ty<>0 THEN fl=0:d1=ABS(d1):RETURN
IF d1>0 OR d2>0 THEN r22
IF a<>0 THEN d1=-d1:d2=-d2:a=0:GOTO r22
GOTO m2
n4:
IF www$="w" THEN u$="White wins ! ! !"
IF www$="z" THEN u$="Black wins ! ! !"
GOSUB uitvoer
FOR iii=0 TO 25000:NEXT

Hansie:
scherm$="Bpicture/Picture P1"+CHR$(0):sch&=ldscr& (SADD(scherm$),WINDOW(7))
CLS

GOTO Qwerty

flip:
FOR i=0 TO 25:b%(i)=c%(i):NEXT:bw=bx:bb=by:RETURN

Computer:
ng=ng-1
FOR i=0 TO 25:c%(i)=b%(i):NEXT:bx=bw:by=bb
ty=1:b1=bx:IF go=1 THEN b1=by
f=-1:t=-1:v1=-9999
IF b1=0 THEN f=d1:GOTO c1
t=d1
c1:
IF d1>0 THEN GOSUB testen:IF fl=0 THEN GOSUB R205:v1=rv
IF b1=0 THEN f=d2:t=-1:GOTO c2
t=d2:f=-1
c2:
GOSU