' 
' (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:
GOSUB flip:IF d2>0 THEN GOSUB testen:w1=d1:d1=d2:d2=w1:IF fl=0 THEN c3
IF v1=-9999 THEN c4
c6:
IF b1=0 THEN f=d1:t=-1:z$="f":GOTO c5
t=d1:f=-1:z$="b"
c5:
z$=z$+STR$(d1)
c55:
u$="Move "+zzz$+z$
c7:
GOSUB uitvoer:FOR jjjjjj=0 TO 5000:NEXT
ty=0:GOSUB flip:GOTO testen
c3:
IF v1<>-9999 THEN GOSUB R205:IF rv*go>v1 THEN c6
w1=d1:d1=d2:d2=w1:GOTO c6
c4:
IF b1<>0 THEN t=-1:f=-1:z$="I can't move":GOTO c55
v1=-9999:IF d1<0 THEN w1=d2:d2=d1:d1=w1:IF d1<0 THEN b1=1:GOTO c4
FOR di=1 TO 2
 GOSUB flip
 w1=1
 IF go<0 THEN w1=24
 FOR k=w1 TO w1+23*go STEP go
  t=k-d1*go
  IF t<=0 OR t>24 THEN r94
  IF b%(k)*go<=0 THEN r94
  f=k:GOSUB testen
  IF fl<>0 THEN r94
  GOSUB R205
  IF rv*go>v1 THEN v1=rv:b3=k:b2=t
  GOSUB flip
r94:
 NEXT
 IF v1=-9999 THEN w1=d1:d1=d2:d2=w1:NEXT:b1=1:GOTO c4
t=b2:f=b3:z$=STR$(f)+" -"+STR$(t):GOTO c55
  
R110:
IF ty<>0 THEN R119
GOSUB zet
RETURN

R119:
b%(np)=b%(np)-m1:RETURN

R128:
IF m1<0 THEN w1=bw:bw=bw+1:GOTO r130
w1=bb:bb=bb+1
r130:
GOSUB Barzet
IF ty<>0 THEN RETURN

RETURN

R133:
IF m1>0 THEN w1=bb:bb=bb-1:GOTO r135
w1=bw:bw=bw-1
r135:
GOSUB Barzet
IF ty<>0 THEN RETURN
  
RETURN

R197:
IF ty<>0 THEN RETURN
IF b%(0)<>0 THEN w2=b%(0):p1=7:GOSUB R201
IF b%(25)<>0 THEN w2=-b%(25):p1=14:GOSUB R201
RETURN

R201:
RETURN

R205:
rv=k4*(bw-bb)
FOR i=1 TO 24
 IF b%(i)=0 THEN R210
 w1=(12.5-SGN(b%(i))*(12.5-i))/6
 IF w1>1 THEN w1=w1+k5
 rv=rv-b%(i)*w1*k1
 IF go*b%(i)=1 THEN rv=rv-b%(i)*(1/w1)*(4-ng)*k2*(1+bw*(1+go)/2+bb*(1-go)/2)
 IF ABS(b%(i))>1 THEN rv=rv-SGN(b%(i))*(w1-9)*k3
R210:
NEXT
RETURN

Gooien:
FOR jjjj=0 TO 5:RANDOMIZE TIMER
G1:
q=INT(RND*6+1):w=INT(RND*6+1):IF q<1 OR q>6 THEN G1
IF w<1 OR w>6 THEN G1
PUT (51,91),dobbel%(0,q),PSET:PUT (93,91),dobbel%(0,w),PSET
FOR jjjjj=0 TO 50:NEXT jjjjj:NEXT jjjj:d1= q:d2= w:d3=q:d4=w
RETURN

Pion:
LINE (x+5,y+0)-(x+9,y+14),co,bf :LINE (x+3,y+1)-(x+11,y+13),co,bf
LINE (x+2,y+2)-(x+12,y+12),co,bf:LINE (x+1,y+3)-(x+13,y+11),co,bf
LINE (x+0,y+5)-(x+14,y+9),co,bf :RETURN

zet:
po=np:aantal=ABS(b%(np)):co=9:IF m1=-1 THEN co=8
Zetten:
PUT (290, 28),zwartgetal%(0,ABS(b%( 0))),PSET
PUT (290,114),  witgetal%(0,ABS(b%(25))),PSET
GOSUB Barzet
IF po <13 THEN GOSUB Top:RETURN
GOSUB Button:RETURN

Top:
w=2:IF po/2 = INT(po/2) THEN w=1
IF po<1 THEN RETURN
PUT (Bordx(po),Bordy(po)),Balkboven%(0,w),PSET
IF aantal=1 THEN GOSUB T1
IF aantal=2 THEN GOSUB T2
IF aantal=3 THEN GOSUB T3
IF aantal>3 THEN GOSUB T4
RETURN

T1: x=x(po):y=y(1):GOSUB Pion:RETURN
T2: GOSUB T1:y=y(2):GOSUB Pion:RETURN
T3: GOSUB T2:y=y(3):GOSUB Pion:RETURN
T4: GOSUB T3
    IF co=8 THEN PUT (x(po)+3,y(1)+4),witgetal%(0,aantal-2),PSET
    IF co=9 THEN PUT (x(po)+3,y(1)+4),zwartgetal%(0,aantal-2),PSET
    RETURN

Button:
w=2:IF po/2 = INT(po/2) THEN w=1
IF po>24 THEN RETURN
PUT (Bordx(po),Bordy(po)),Balkonder%(0,w),PSET
IF aantal=1 THEN GOSUB b1
IF aantal=2 THEN GOSUB b2
IF aantal=3 THEN GOSUB b3
IF aantal>3 THEN GOSUB B4
RETURN

b1: x=x(po):y=y(6):GOSUB Pion:RETURN
b2: GOSUB b1:y=y(5):GOSUB Pion:RETURN
b3: GOSUB b2:y=y(4):GOSUB Pion:RETURN
B4: GOSUB b3
    IF co=8 THEN PUT (x(po)+3,y(6)+4),witgetal%(0,aantal-2),PSET
    IF co=9 THEN PUT (x(po)+3,y(6)+4),zwartgetal%(0,aantal-2),PSET
    RETURN

invoer:
GOSUB muisje
RETURN

invoer1:
i$="1"
RETURN

uitvoer:
LINE (10,200)-(300,216),0,bf
Positie 10,213:COLOR 8
FOR hghg=1 TO LEN(u$)
IF MID$(u$,hghg,1)="-"THEN PRINT ":";:GOTO fff
PRINT MID$(u$,hghg,1);
fff:
NEXT hghg
RETURN

inpzet:
GOSUB invoer

z$=i$
f=0:t=0
IF LEFT$(z$,1)="0" THEN f=-1:t=-1:RETURN
IF LEN(z$)<2 THEN inperr
IF LEFT$(z$,1)<>"b" THEN iz1
f=-1:t=VAL(RIGHT$(z$,LEN(z$)-1)):RETURN

iz1:
IF LEFT$(z$,1)<>"f" THEN iz2
t=-1:f=pakken:RETURN:'***** :VAL(RIGHT$(z$,LEN(z$)-1)):RETURN *****

iz2:
IF LEN(z$)<3 THEN inperr

FOR i=2 TO LEN(z$)-1
 IF MID$(z$,i,1)<>"-" THEN jos1
 f=VAL(LEFT$(z$,i-1)):t=VAL(RIGHT$(z$,LEN(z$)-i))
RETURN

inperr:
u$="Wrong entry":GOSUB uitvoer
GOTO inpzet

jos1:
NEXT : GOTO inperr
 
Barzet:
PUT (134+3, 90+3),  witgetal%(0,bw),PSET
PUT (134+3,108+4),zwartgetal%(0,bb),PSET
RETURN

muisje:
IF ABS(d1)=d3 THEN d3=d1:d4=d2:GOTO muis
d3=d2:d4=d1

muis:
aaaa=MOUSE(0)

Muis1:
IF MOUSE(0)=0 THEN Muis1
xxx=MOUSE(1):yyy=MOUSE(2)

pakken=0
IF ((xxx>50)AND(xxx< 82)) THEN pakken=d3
IF ((xxx>92)AND(xxx<124)) THEN pakken=d4
IF ((xxx> 8)AND(xxx< 39)) THEN i$="0":RETURN
IF pakken<=0 THEN muis

Muis4:
aaaa=MOUSE(0)

Muis2:
IF MOUSE(0)=0 THEN Muis2
xxx=MOUSE(1):yyy=MOUSE(2)

welke=9999
IF yyy<23 THEN Muis3
IF yyy>81 THEN Muis3
IF xxx>3   AND xxx<137 THEN welke=12-INT((xxx-  4)/22)
IF xxx>145 AND xxx<279 THEN welke= 6-INT((xxx-146)/22)
IF welke=9999 THEN Muis4
GOTO Muisend

Muis3:
IF yyy<130 THEN Muis5
IF yyy>187 THEN Muis5
IF xxx>3   AND xxx<137 THEN welke=13+INT((xxx-  4)/22)
IF xxx>145 AND xxx<279 THEN welke=19+INT((xxx-146)/22)
IF welke=9999 THEN Muis4
GOTO Muisend

Muis5:
IF xxx>129 AND xxx<153 AND yyy>88 AND yyy<123 THEN welke=100
IF welke=9999 THEN Muis4

Muisend:
i$=""
IF welke=100 THEN Welken
IF go=-1 THEN ppp=welke+pakken
IF go= 1 THEN ppp=welke-pakken
IF ppp=>25 THEN i$="f"+STR$(25-welke):RETURN
IF ppp=<0 THEN i$="f"+STR$(welke):RETURN
i$=STR$(welke)+"-":iii$=STR$(ppp) 
IF i$<>"" THEN i$=RIGHT$(i$,LEN(i$)-1)+RIGHT$(iii$,LEN(iii$)-1)
RETURN

Welken:
IF go=-1 THEN ppp= 0+pakken:i$="b"+STR$(ppp)
IF go= 1 THEN ppp=25-pakken:i$="b"+STR$(ppp)
RETURN

SUB Diskfont (font$,hoogte%) STATIC
 SHARED strFont&
 prefs%=96
 font0$=font$+".font"+CHR$(0)
 IF strFont&<>0 THEN CALL CloseFont (strFont&)
 textAttr&(0)=SADD(font0$)
 textAttr&(1)=hoogte%*2^16+prefs%
 strFont&=OpenDiskFont&(VARPTR(textAttr&(0)))
 IF strFont&<>0 THEN CALL SetFont (WINDOW(8),strFont&)
END SUB

SUB Positie (x%,y%) STATIC
 e&=move&(WINDOW(8),x%,y%)
END SUB