Home » Archimedes archive » Archimedes World » AW-1992-04.adf » April92 » !AWApr92/Goodies/BackGammon/!Backgamon/Backgammon
!AWApr92/Goodies/BackGammon/!Backgamon/Backgammon
This website contains an archive of files for the Acorn Electron, BBC Micro, Acorn Archimedes, Commodore 16 and Commodore 64 computers, which Dominic Ford has rescued from his private collection of floppy disks and cassettes.
Some of these files were originally commercial releases in the 1980s and 1990s, but they are now widely available online. I assume that copyright over them is no longer being asserted. If you own the copyright and would like files to be removed, please contact me.
| Tape/disk: | Home » Archimedes archive » Archimedes World » AW-1992-04.adf » April92 |
| Filename: | !AWApr92/Goodies/BackGammon/!Backgamon/Backgammon |
| Read OK: | ✔ |
| File size: | D1BB bytes |
| Load address: | 0000 |
| Exec address: | 0000 |
Duplicates
There is 1 duplicate copy of this file in the archive:
- Archimedes archive » Archimedes World » AW-1992-04.adf » April92 » !AWApr92/Goodies/BackGammon/!Backgamon/Backgammon
- Recent acquisitions » Acorn ADFS disks » adfs_ArchimedesWorld_199204.adf » April92 » !AWApr92/Goodies/BackGammon/!Backgamon/Backgammon
File contents
10REM> <Backg$Dir>.Backgammon
20REM Jonathan Evans, December 1989
25REM (c) Archimedes World April 1992
30
40*FX200,1
50PROCinit
60REPEAT
70PROCinitgame
80PROCscreen
90PROCstartgame
100PROCplay
110UNTIL FALSE
120END
130
140DEFPROCscreen
150LOCAL screen
160update_bank=2:display_bank=2
170*FX113,2
180*FX112,2
190SYS "Hourglass_On"
200COLOUR 128+black:CLS
210FOR screen = 1 TO 2
220PROCswitch_update_bank
230PROCboard
240PROCpanel
250PROCswitch_display_bank
260MOUSE ON
270NEXT screen
280SYS "Hourglass_Off"
290ENDPROC
300
310DEFPROCinit
320X=RND(-TIME)
330MODE 140: VDU 23,0,10,32|
340blackmoney=1000:whitemoney=1000:blackplayer$="COMPUTER":whiteplayer$="HUMAN"
350midgrey = 9: lightgrey = 10: darkgrey = 11: black = 0: white = 7
360green = 2: brown = 6: red = 1: blue = 4: ivory = 14
370COLOUR midgrey, 128,128,128: COLOUR darkgrey, 64,64,64: COLOUR lightgrey, 196,196,196
380COLOUR green, 32,132,32: COLOUR brown, 148,50,52: COLOUR red,200,16,016
390COLOUR 15,0,0,0:COLOUR 14,240,240,176: REM dice colours
400DIM board 24, initboard 24, bestboard 24,whiteblots 24,blackblots 24,white_cover 24,black_cover 24
410boardsize = 1024: bordersize = 48: barwidth = 72: pointwidth = (boardsize-2*bordersize-barwidth)/12: pointheight = 380: ytop = boardsize-bordersize-2: ybottom = bordersize+6: piecesize = 60
420DIM whitethrowbox(4),blackthrowbox(4),gamebox(4),dice(2),showdice(4),barbox(4)
430barbox(1)=(boardsize-barwidth)/2:barbox(2)=0:barbox(3)=barbox(1)+barwidth:barbox(4)=barbox(4)+boardsize
440blackthrowbox(1)=bordersize+16:blackthrowbox(2)=bordersize+pointheight+16:blackthrowbox(3)=(boardsize-barwidth)/2-16:blackthrowbox(4)=boardsize-bordersize-pointheight-16
450whitethrowbox(1)=(boardsize+barwidth)/2+4:whitethrowbox(2)=blackthrowbox(2):whitethrowbox(3)=boardsize-bordersize-4:whitethrowbox(4)=blackthrowbox(4)
460gamebox(1)=0:gamebox(2)=0:gamebox(3)=boardsize:gamebox(4)=boardsize
470evaldisplay$="ON":double=FALSE:firstpair=FALSE
480DIM legalmoves(5,50):nlegal=0
490DIM opttext$(5),pointbox(4),surebox(4)
500surebox(1)=1240/3-32:surebox(2)=1024/3
510surebox(3)=2*surebox(1):surebox(4)=2*surebox(2)
520FOR i = 1 TO 5:READ opttext$(i):NEXT i
530DATA "WHITE","BLACK","MONEY","VALUE","QUIT"
540DIM optbox(4),cantbox(4): optbox(1)=1240/4:optbox(2)=1024/4:optbox(3)=optbox(1)+1024/2:optbox(4)=optbox(2)+1024/2
550cantbox()=optbox():cantbox(2)+=80:cantbox(4)-=80
560DIM bestmoves(40),newboard 24
570PROCinitpieces
580PROCinitpanels
590PROCinit_weightings
600PROCinit_opening_moves
610PROCinit_sprites
620VOICES 2
630*CHANNELVOICE 1 1
640*CHANNELVOICE 2 6
650*<Backg$Dir>.HAND3
660MOUSE ON 1
670ENDPROC
680
690DEFPROCinit_sprites
700spritesize% = 100*1024
710DIM spritearea spritesize%
720!spritearea = spritesize%
730spritearea!4=0
740spritearea!8=16
750spritearea!16=16
760SYS "OS_SpriteOp",256+10,spritearea,"<Backg$Dir>.sprites"
770ENDPROC
780
790DEFPROCinitgame
800whiteturn=TRUE:gameinprogress=FALSE: whitegamescore=0:blackgamescore=0
810barblack=0:barwhite = 0:dicerolled=FALSE
820PROCinitpanelactivity
830doublecube = 64:doubleturn$ = "either":doubled=FALSE
840blackpieces=15:whitepieces=15:winner$=""
850blackopening=TRUE: whiteopening=TRUE: current_score=0
860allpast=FALSE: allpast_weight=FALSE: double_refused = FALSE
870display_bank=2:update_bank=2:*SHADOW
880whitebearing=FALSE:blackbearing=FALSE
890ENDPROC
900
910DEFPROCinitpanels
920LOCAL panno
930REM initialise panels in right hand strip
940DIM paneltext$(4),panel(4),panels(4,4),panelactive(5),movepanel(4),dicepanel(4),optpanel(4),quitpanel(4),okpanel(4),panelbox(4)
950optpanel(1)=optbox(1)+200:optpanel(2)=optbox(4)-112:optpanel(3)=optpanel(1)+240:optpanel(4)=optpanel(2)+50
960quitpanel(1)=optbox(1)+60:quitpanel(2)=optbox(2)+50:quitpanel(3)=quitpanel(1)+300:quitpanel(4)=quitpanel(2)+80
970okpanel(1)=quitpanel(1)+320:okpanel(2)=quitpanel(2):okpanel(3)=okpanel(1)+80:okpanel(4)=quitpanel(4)
980paneltext$(1)="ROLL DICE": paneltext$(2)="OFFER DOUBLE": paneltext$(3) = "SET OPTIONS": paneltext$(4) = "START GAME"
990panel(1) = boardsize+16:panel(3)=panel(1)+200:panel(2) =320:panel(4)=400
1000dicepanel()=panel():dicepanel(2)+=100:dicepanel(4)+=100
1010movepanel(1)=panel(1):movepanel(3)=panel(3):movepanel(2)=730:movepanel(4)=780
1020FOR panno = 1 TO 4
1030panels(1,panno) = panel(1)
1040panels(2,panno) = panel(2)-100*(panno-1)
1050panels(3,panno) = panel(3)
1060panels(4,panno) = panel(4)-100*(panno-1)
1070NEXT panno
1080panelbox(1)=panels(1,4):panelbox(2)=panels(2,4):panelbox(3)=panels(3,1):panelbox(4)=panels(4,1)
1090ENDPROC
1100
1110
1120DEFPROCinitpanelactivity
1130REM sets up initial state of panel activity
1140panelactive(1)=FALSE: panelactive(2) = FALSE: panelactive(3) = TRUE: panelactive(4) = TRUE
1150ENDPROC
1160
1170
1180DEFPROCboard
1190REM draws board at start of new game
1200COLOUR 128+black:CLS
1210LOCAL i
1220FOR i = 1 TO 24: board?i = initboard?i:NEXT i
1230REM FOR i = 1 TO 24: board?i = testboard?i:NEXT i:blackpieces=11:whitepieces=9:blackopening=FALSE:whiteopening=FALSE
1240GCOL midgrey: RECTANGLE FILL boardsize+8,0,1240-boardsize,boardsize
1250GCOL brown: RECTANGLE FILL 0,0,boardsize,boardsize
1260GCOL green: RECTANGLE FILL bordersize,bordersize,boardsize-2*bordersize, boardsize-2*bordersize
1270GCOL black: RECTANGLE bordersize,bordersize,boardsize-2*bordersize, boardsize-2*bordersize
1280MOVE bordersize,bordersize:DRAW 0,0
1290MOVE bordersize,boardsize-bordersize:DRAW 0,boardsize
1300MOVE boardsize-bordersize,bordersize:DRAW boardsize,0
1310MOVE boardsize-bordersize,boardsize-bordersize: DRAW boardsize,boardsize
1320PROCdrawpoints
1330PROCdrawbar
1340ENDPROC
1350
1360
1370DEFPROCdraw_inner_rects
1380REM black outline rectangles to replace possible obscuring
1390REM by redrawing of points
1400LOCAL width,height,barright
1410GCOL black
1420width = (boardsize-barwidth)/2 - bordersize
1430barright = width+bordersize+barwidth
1440height=boardsize-2*bordersize
1450WAIT
1460RECTANGLE bordersize,bordersize,width,height
1470WAIT
1480RECTANGLE barright,bordersize,width,height
1490ENDPROC
1500
1510DEFPROCshadow_drawbar
1520PROCswitch_display_bank
1530PROCdrawbar
1540PROCswitch_display_bank
1550PROCshadow_box(barbox())
1560ENDPROC
1570
1580DEFPROCdrawbar
1590LOCAL barleft,x,y,xoff,yoff
1600barleft = (boardsize-barwidth)/2
1610GCOL brown: RECTANGLE FILL barleft,0,barwidth,boardsize
1620GCOL black:RECTANGLE (boardsize-barwidth)/2,bordersize,barwidth,boardsize-2*bordersize
1630IF barblack>0 THEN PROCpiecesonbar(barblack,"black")
1640IF barwhite>0 THEN PROCpiecesonbar(barwhite,"white")
1650REM draw doubleing cube
1660x = barleft+10: y = boardsize/2-20
1670GCOL ivory
1680RECTANGLE FILL x,y,54,54
1690GCOL black
1700RECTANGLE x,y,54,54
1710yoff = 36: IF doublecube > 9 THEN xoff = 10 ELSE xoff = 20
1720VDU 5: GCOL blue
1730MOVE x+xoff,y+yoff:PRINT; doublecube
1740VDU 4
1750REM IF gameinprogress THEN PROCshadow_box(barbox())
1760ENDPROC
1770
1780DEFPROCpiecesonbar(nopieces,col$)
1790LOCAL piece,x,y
1800CASE col$ OF
1810WHEN "black":
1820PROCstartpoint(18,x,y)
1830x+=pointwidth+barwidth/2-piecesize/2
1840WHEN "white":
1850PROCstartpoint(7,x,y)
1860x+=pointwidth+barwidth/2-piecesize/2
1870ENDCASE
1880FOR piece = 1 TO nopieces
1890offset = (piece-0.50)*piecesize
1900CASE col$ OF
1910WHEN "black"
1920y = ybottom +offset-piecesize/2
1930MOVE x,y:PROCplot_sprite(col$,8)
1940WHEN "white"
1950y = ytop -offset-piecesize/2
1960MOVEx,y:PROCplot_sprite(col$,8)
1970ENDCASE
1980NEXT piece
1990ENDPROC
2000
2010DEFPROCdrawpoints
2020LOCAL point,pointcolour,startpoint
2030FOR point = 1 TO 24
2040PROCdrawpoint(point)
2050NEXT point
2060ENDPROC
2070
2080DEFPROCshadow_drawpoint(point,mfb)
2090LOCAL screen
2100IF mfb THEN PROCshadow_drawbar
2110PROCswitch_update_bank
2120PROCdrawpoint(point)
2130PROCswitch_display_bank
2140PROCgrabbox(pointbox(),"temp")
2150PROCswitch_update_bank
2160PROCrestorebox(pointbox(),"temp")
2170PROCswitch_update_bank
2180ENDPROC
2190
2200DEFPROCdrawpoint(point)
2210LOCAL piece,pieces,piececol,offset,s$,r,screen
2220REM Draw point
2230IF point <13 THEN offset = -pointheight ELSE offset = pointheight
2240PROCstartpoint(point,x,y):GCOLgreen: RECTANGLE FILL x,y,pointwidth,offset
2250IF point > 12 THEN
2260pointbox(1)=x:pointbox(2)=y:pointbox(3)=x+pointwidth:pointbox(4)=y+offset
2270ELSE
2280pointbox(1)=x:pointbox(2)=y+offset:pointbox(3)=x+pointwidth:pointbox(4)=y
2290ENDIF
2300IF point MOD 2 = 1 THEN pointcolour = lightgrey ELSE pointcolour = red
2310GCOL pointcolour
2320MOVE x,y: MOVE x+pointwidth,y
2330IF point < 13 THEN PLOT 81,-pointwidth/2,-pointheight ELSE PLOT 81,-pointwidth/2,pointheight
2340REM Draw pieces on point
2350pieces = board?point
2360IF pieces >0 THEN
2370IF pieces >128 THEN piececol = black: pieces = pieces MOD 128 ELSE piececol=white
2380r=piecesize/2
2390x+= pointwidth/2-r: piece=0
2400IF piececol = white THEN s$="white" ELSE s$="black"
2410REPEAT: piece+=1
2420offset = (piece-0.50)*piecesize
2430IF point < 13 THEN y = ytop - offset-r ELSE y = ybottom + offset-r
2440REM GCOL piececol: CIRCLE FILL x,y,piecesize/2
2450REM IF piececol = white THEN GCOL black: CIRCLE x,y,piecesize/2
2460MOVE x,y: PROCplot_sprite(s$,8)
2470UNTIL piece = pieces OR piece = 6
2480IF pieces >6 THEN PROCnumberpile(pieces,x+r,y+r,piececol)
2490ENDIF
2500REM GCOL black: RECTANGLE bordersize,bordersize,boardsize-2*bordersize, boardsize-2*bordersize
2510PROCdraw_inner_rects
2520ENDPROC
2530
2540DEFPROCstartpoint(point,RETURN x,RETURN y)
2550REM finds top left hand co-ordinates of point
2560IF point <13 THEN y = ytop ELSE y = ybottom: point = 25-point
2570x = boardsize-bordersize-point*pointwidth
2580IF point > 6 THEN x-= barwidth
2590ENDPROC
2600
2610DEFPROCinitpieces
2620LOCAL point,pieces
2630DIM testboard 24
2640FOR point = 1 TO 24
2650READ pieces: initboard?point = pieces
2660NEXT point
2670DATA 2,0,0,0,0,128+5,0,128+3,0,0,0,5,128+5,0,0,0,3,0,5,0,0,0,0,128+2
2680FOR point = 1 TO 24
2690READ pieces: testboard?point = pieces
2700NEXT point
2710DATA 128+3,3,0,0,0,128+2,0,128+3,0,0,0,0,0,0,0,0,0,0,0,2,0,128+3,0,4
2720barwhite=0:barblack=0
2730ENDPROC
2740
2750DEFPROCnumberpile(no,x,y,piececol)
2760LOCAL nocol,xoff,yoff
2770yoff = 12: IF no > 9 THEN xoff = -16 ELSE xoff = -8
2780IF piececol = black THEN nocol = white ELSE nocol = black
2790VDU 5: GCOL nocol
2800MOVE x+xoff,y+yoff:PRINT; no
2810VDU 4
2820ENDPROC
2830
2840REM Mouse and sprite library procedures
2850REM ===================================
2860
2870DEFPROCdrawtextbox(box(),text$,boxcol%,textcol%)
2880REM Draws unfilled box colour boxcol%
2890REM and centres text label printed in colour textcol%
2900LOCAL boxwidth%,boxheight%,textwidth%, textx, texty
2910VDU5: GCOL boxcol%
2920RECTANGLE FILL box(1),box(2),box(3)-box(1),box(4)-box(2)
2930GCOL black:RECTANGLE box(1),box(2),box(3)-box(1),box(4)-box(2)
2940textwidth%=LEN(text$)*1280 DIV 80
2950boxwidth% = box(3)-box(1)
2960boxheight% = box(4) - box(2)
2970textx = box(1)+(boxwidth%-textwidth%) DIV 2
2980texty = box(2)+(boxheight%-16) DIV 2 + 16
2990GCOL textcol%
3000MOVE textx,texty
3010PRINT text$
3020VDU4
3030ENDPROC
3040
3050DEFFNmouseinbox(box(),RETURN button)
3060REM Returns TRUE if mouse clicked inside box, otherwise FALSE
3070REM Also returns variable holding value of button
3080LOCAL x,y,t
3090*FX15
3100MOUSE x,y,button
3110IF button THEN
3120PROCdelay(1)
3130REM delay to give user time to release button
3140IF x>= box(1) AND x <= box(3) AND y >= box(2) AND y <= box(4) THEN = TRUE ELSE =FALSE
3150ELSE
3160=FALSE
3170ENDIF
3180
3190DEFPROCplot_sprite(sprite$,action)
3200REM Plots sprite using mask
3210SYS "OS_SpriteOp",256+28,spritearea,sprite$,,,action
3220ENDPROC
3230
3240DEFPROCget_sprite(sprite$,box())
3250MOVE box(1),box(2):MOVE box(3),box(4)
3260SYS "OS_SpriteOp",256+14,spritearea,sprite$
3270ENDPROC
3280
3290DEFPROCgrabbox(box(),sprite$)
3300REM grabs the screen area defined by box and
3310REM saves it as a sprite called sprite$
3320PROCget_sprite(sprite$,box())
3330ENDPROC
3340
3350DEFPROCrestorebox(box(),sprite$)
3360REM restores screen area defined by box and previously
3370REM saved by PROCgrabbox
3380MOVE box(1),box(2)
3390PROCplot_sprite(sprite$,0)
3400PROCdelay(20):*FX15
3410ENDPROC
3420
3430DEFPROCgraphicwindow(box())
3440REM creates graphic window of the area specified by box()
3450VDU24,box(1);box(2);box(3);box(4);
3460ENDPROC
3470
3480REM End of mouse/sprite library procedures
3490REM ======================================
3500
3510DEFPROCdice
3520IF startset THEN startset = FALSE:ENDPROC
3530IF whiteturn THEN PROCrolldice(whitethrowbox()) ELSE PROCrolldice(blackthrowbox())
3540ENDPROC
3550
3560DEFPROCrolldice(throwbox())
3570LOCAL x1,y1,x2,y2,toss,ntosses,a,d,p,count
3580PROCdrawtextbox(dicepanel(),"",ivory,ivory)
3590ntosses=12:count =0
3600REM REPEAT
3610FOR toss = 1 TO ntosses
3620dice1=RND(6):dice2=RND(6)
3621
3630REM This is the cheating bit
3631REM ==== == === ======== ===
3640REM IF col$="white" THEN dice2=dice1
3641
3650x1 = throwbox(1)+20+RND(180)
3660y1 = throwbox(2)+20+RND(60)
3670x2 = x1+60+RND(60)
3680y2 = throwbox(2)+20+RND(60)
3690MOVE x1,y1
3700PROCplot_sprite(STR$dice1,0)
3710MOVE x2,y2
3720PROCplot_sprite(STR$dice2,0)
3730count+=1
3740IF count=2 THEN
3750count=0
3760a=1:p=120+RND(30):d=5+RND(5)
3770SOUND 2,-a,p,d: PROCdelay(5)
3780ENDIF
3790IF toss < ntosses THEN PROCclearthrowbox(throwbox())
3800NEXT toss
3810PROCswitch_update_bank
3820MOVE x1,y1: PROCplot_sprite(STR$dice1,0)
3830MOVE x2,y2: PROCplot_sprite(STR$dice2,0)
3840PROCswitch_update_bank
3850REM UNTIL dice1=dice2
3860PROCsetdice(dice1,dice2)
3870ENDPROC
3880
3890DEFPROCsetdice(dice1,dice2)
3900IF dice1 <dice2 THEN SWAP dice1,dice2
3910IF dice1 = dice2 THEN double=TRUE ELSE double=FALSE
3920dice(1)=dice1:dice(2)=dice2:dice(0)=2
3930diceavailable = 2
3940REM IF double THEN dice(3)=dice1:dice(4)=dice1
3950ENDPROC
3960
3970DEFPROCrollstartdice(col$,dice1,RETURN dice)
3980LOCAL throwbox():DIM throwbox(4)
3990IF col$="white" THEN throwbox()=whitethrowbox() ELSE throwbox()=blackthrowbox()
4000ntosses=8:count =0
4010FOR toss = 1 TO ntosses
4020dice=RND(6)
4030IF (col$="black" AND dice=dice1 AND toss=ntosses) THEN
4040REPEAT:dice=RND(6):UNTIL dice<>dice1
4050ENDIF
4060x1 = throwbox(1)+20+RND(200)
4070y1 = throwbox(2)+20+RND(60)
4080x2 = x1+60+RND(80)
4090y2 = throwbox(2)+20+RND(60)
4100MOVE x1,y1
4110PROCplot_sprite(STR$dice,0)
4120count+=1
4130IF count=2 THEN
4140count=0
4150a=1:p=120+RND(30):d=5+RND(5)
4160SOUND 2,-a,p,d: PROCdelay(5)
4170ENDIF
4180IF toss < ntosses THEN PROCclearthrowbox(throwbox())
4190IF toss=ntosses THEN
4200PROCswitch_update_bank
4210MOVE x1,y1:PROCplot_sprite(STR$dice,0)
4220PROCswitch_update_bank
4230ENDIF
4240NEXT toss
4250ENDPROC
4260
4270DEFPROCdelay(t)
4280TIME=0:REPEAT UNTIL TIME > t
4290ENDPROC
4300
4310DEFPROCclearthrowbox(throwbox())
4320GCOL green: RECTANGLE FILL throwbox(1),throwbox(2),throwbox(3)-throwbox(1),throwbox(4)-throwbox(2)
4330ENDPROC
4340
4350DEFPROCshadow_panel
4360LOCAL screen
4370FOR screen = 1 TO 2
4380PROCswitch_update_bank
4390PROCpanel
4400PROCswitch_display_bank
4410NEXT screen
4420ENDPROC
4430
4440DEFPROCpanel
4450GCOL midgrey
4460RECTANGLE FILL boardsize+8,0,1240-boardsize,boardsize
4470COLOUR 128+midgrey
4480COLOUR white
4490PRINT TAB(66,1);"W H I T E"
4500PRINT TAB(66,3) FNcentre(whiteplayer$)
4510PRINT TAB(69,4);"�";whitemoney
4520PRINT TAB(66,5);"Game score "
4530PRINT TAB(70,6);whitegamescore
4540COLOUR black
4550PRINT TAB(66,10)"B L A C K"
4560PRINT TAB(66,12) FNcentre(blackplayer$)
4570PRINT TAB(69,13) "�";blackmoney
4580PRINT TAB(66,14);"Game score "
4590PRINT TAB(70,15);blackgamescore
4600PROCmovepanel
4610PROCdrawpanels
4620PROCdicepanel
4630ENDPROC
4640
4650DEFFNcentre(S$)
4660LOCAL L%
4670L%=LENS$
4680IF L% <10 THEN S$=STRING$((10-L%)DIV2," ")+S$
4690=S$
4700
4710DEFPROCdicepanel
4720LOCAL dice,roll,xoff,i,n,s
4730IF double THEN
4740xoff = 8:n=4
4750IF firstpair THEN
4760showdice(1)=dice(1):showdice(2)=dice(2)
4770showdice(3)=dice(1) MOD 128: showdice(4)=dice(2) MOD 128
4780ELSE
4790showdice(1)=dice(1)+128:showdice(2)=dice(2)+128
4800showdice(3)=dice(1):showdice(4)=dice(2)
4810ENDIF
4820ELSE
4830showdice(1)=dice(1):showdice(2)=dice(2)
4840xoff = 40:n=2
4850ENDIF
4860VDU 5
4870IF dicerolled THEN
4880FOR dice = 1 TO n
4890roll = showdice(dice)
4900IF roll > 128 THEN GCOL lightgrey ELSE GCOL black
4910MOVE dicepanel(1)+xoff+30*dice,dicepanel(2)+48
4920PRINT; roll MOD 128
4930NEXT dice
4940ELSE
4950PROCdrawtextbox(dicepanel(),"",ivory,ivory)
4960ENDIF
4970VDU4
4980IF gameinprogress PROCshadow_box(dicepanel())
4990ENDPROC
5000
5010DEFPROCmovepanel
5020LOCAL text$
5030IF gameinprogress THEN
5040IF whiteturn THEN text$="White Move" ELSE text$="Black Move"
5050ELSE
5060text$="New Game"
5070ENDIF
5080PROCdrawtextbox(movepanel(),text$,ivory,blue)
5090IF gameinprogress THEN PROCshadow_box(movepanel())
5100ENDPROC
5110
5120DEFPROCdrawpanels
5130LOCAL panno,textcol,s
5140IF gameinprogress THEN paneltext$(4)="QUIT GAME" ELSE paneltext$(4)="START GAME"
5150FOR panno = 1 TO 4
5160IF panelactive(panno) THEN textcol = red ELSE textcol = lightgrey
5170PROCpanelcoords(panno,panel())
5180PROCdrawtextbox(panel(),paneltext$(panno),white,textcol)
5190NEXT panno
5200IF gameinprogress THEN PROCshadow_box(panelbox())
5210ENDPROC
5220
5230DEFPROCdraw_double_panel
5240LOCAL s,d:d=2
5250FOR s = 1 TO 2
5260PROCswitch_update_bank
5270PROCpanelcoords(d,panel())
5280PROCdrawtextbox(panel(),paneltext$(d),white,lightgrey)
5290PROCswitch_display_bank
5300NEXT s
5310ENDPROC
5320
5330DEFPROCpanelcoords(panno,panel())
5340LOCAL i
5350FOR i = 1 TO 4
5360panel(i) = panels(i,panno)
5370NEXT i
5380ENDPROC
5390
5400DEFPROCstartgame
5410LOCAL panno,x,y,button
5420REPEAT
5430panno = FNgetpanel
5440IF panno = 3 THEN PROCsetoptions
5450UNTIL panno = 4
5460PROCchoosestart
5470IF whiteplayer$="HUMAN" THEN whiteopening=FALSE
5480IF blackplayer$="HUMAN" THEN blackopening=FALSE
5490gameinprogress=TRUE
5500ENDPROC
5510
5520DEFPROCchoosestart
5530LOCAL dicew,diceb,message$,box()
5540DIM box(4):box()=cantbox():box(2)-=270:box(4)-=270:box(1)-=60:box(3)-=60
5550PROCrollstartdice("white",0,dice1)
5560PROCrollstartdice("black",dice1,dice2)
5570whiteturn = (dice1>dice2)
5580IF whiteturn THEN message$="WHITE STARTS" ELSE message$="BLACK STARTS"
5590PROCgrabbox(box(),"temp")
5600PROCdisplaybox(box(),message$)
5610PROCrestorebox(box(),"temp")
5620PROCsetdice(dice1,dice2):startset=TRUE
5630ENDPROC
5640
5650DEFFNgetpanel
5660REM checks mouse presses in panel and returns number
5670REM if active panel clicked else 0
5680LOCAL panno, button,x,y, found,last: panno = 0: found = FALSE
5690IF gameinprogress THEN last=5 ELSE last=4
5700REPEAT
5710panno +=1
5720IF panno=5 THEN
5730panel()=gamebox()
5740ELSE
5750PROCpanelcoords(panno,panel())
5760ENDIF
5770IF FNmouseinbox(panel(),button) THEN
5780IF panelactive(panno) OR panno=5 THEN found = TRUE ELSE VDU7
5790ENDIF
5800UNTIL found OR panno = last
5810IF panno=5 THEN panno=1
5820IF found THEN = panno ELSE = 0
5830
5840DEFPROCsetoptions
5850LOCAL moneyreset,ok
5860moneyreset=FALSE
5870PROCgrabbox(optbox(),"temp")
5880PROCoptionsbox
5890ok=FALSE
5900REPEAT
5910panel()=optpanel()
5920button=0
5930FOR i = 1 TO 4
5940IF i>1 THEN panel(2)-=76:panel(4)-=76
5950IF FNmouseinbox(panel(),button)THEN
5960CASE i OF
5970WHEN 1: IF whiteplayer$="COMPUTER" THEN whiteplayer$="HUMAN" ELSE whiteplayer$="COMPUTER"
5980PROCdrawtextbox(panel(),whiteplayer$,white,red)
5990WHEN 2: IF blackplayer$="COMPUTER" THEN blackplayer$="HUMAN" ELSE blackplayer$="COMPUTER"
6000PROCdrawtextbox(panel(),blackplayer$,white,red)
6010WHEN 3: blackmoney=100:whitemoney=100
6020IF moneyreset THEN moneyreset=FALSE:PROCdrawtextbox(panel(),"RESET",white,red) ELSE moneyreset=TRUE:PROCdrawtextbox(panel(),"RESET",white,lightgrey)
6030WHEN 4: IF evaldisplay$="ON" THEN evaldisplay$="OFF" ELSE evaldisplay$="ON"
6040PROCdrawtextbox(panel(),evaldisplay$,white,red)
6050ENDCASE
6060ENDIF
6070MOUSE RECTANGLE optbox(1),optbox(2),optbox(3)-optbox(1),optbox(4)-optbox(2)
6080NEXT i
6090IF FNmouseinbox(quitpanel(),button) THEN sure=FNsurebox(""):IF sure THEN MODE12:OSCLI("FX 200,0"):END
6100IF FNmouseinbox(okpanel(),button) THEN ok=TRUE
6110UNTIL ok
6120button=0:*FX15
6130REPEAT
6140MOUSE x,y,button
6150UNTIL button
6160MOUSE RECTANGLE 0,0,1239,1203
6170VDU4
6180PROCrestorebox(optbox(),"temp")
6190PROCshadow_panel
6200ENDPROC
6210
6220DEFPROCoptionsbox
6230LOCAL i,x,y,border:border=32
6240VDU5
6250PROCshowbox(optbox(),black,ivory)
6260x=optbox(1)+2*border
6270GCOL black
6280FOR i = 1 TO 4
6290y=optbox(4)-i*76
6300MOVE x,y:PRINT opttext$(i)
6310NEXT i
6320PROCdrawtextbox(quitpanel(),"QUIT PROGRAM",white,blue)
6330PROCdrawtextbox(okpanel(),"OK",lightgrey,black)
6340panel()=optpanel()
6350FOR i = 1 TO 4
6360IF i>1 THEN panel(2)-=76:panel(4)-=76
6370CASE i OF
6380WHEN 1: text$=whiteplayer$
6390WHEN 2: text$=blackplayer$
6400WHEN 3: text$="RESET"
6410WHEN 4: text$=evaldisplay$
6420ENDCASE
6430PROCdrawtextbox(panel(),text$,white,red)
6440NEXT i
6450ENDPROC
6460
6470
6480DEFPROCplay
6490LOCAL x,y,button,screen
6500*FX200,0
6510LOCAL ERROR
6520ON ERROR LOCAL gameinprogress=FALSE:MOUSE ON:MOUSE RECTANGLE 0,0,1239,1023:VDU4,26:OSCLI("FX 200,1"):ENDPROC
6530IF whiteplayer$="COMPUTER" AND blackplayer$="COMPUTER" THEN MOUSE OFF
6540WHILE gameinprogress
6550IF whiteturn THEN
6560IF whiteplayer$ = "HUMAN" THEN PROChumanplay("white") ELSE PROCcomputerplay("white")
6570whiteturn = FALSE
6580ELSE
6590IF blackplayer$ = "HUMAN" THEN PROChumanplay("black") ELSE PROCcomputerplay("black")
6600whiteturn = TRUE
6610ENDIF
6620FOR screen = 1 TO 2
6630PROCclearthrowbox(whitethrowbox()):PROCclearthrowbox(blackthrowbox())
6640PROCswitch_update_bank
6650NEXT screen
6660PROCshowscore
6670IF gameinprogress AND NOT (whiteplayer$="COMPUTER" AND blackplayer$="COMPUTER") THEN
6680REM IF (whiteturn AND whiteplayer$="COMPUTER") OR (NOT whiteturn AND blackplayer$="COMPUTER") THEN
6690REM button=0:*FX15
6700REM REPEAT:MOUSE x,y,button:UNTIL button
6710REM ENDIF
6720ENDIF
6730IF allpast AND NOT allpast_weight THEN PROCallpast_weightings: allpast_weight = TRUE
6740ENDWHILE
6750MOUSE ON
6760*FX200,0
6770ENDPROC
6780
6790DEFFNallpast
6800REM returns TRUE when pieces of each colour are past each other
6810REM and no hitting is possible
6820LOCAL point,present,allpast,found,maxblack,minwhite
6830IF barwhite OR barblack THEN =FALSE
6840point=0:found=FALSE
6850WHILE NOT found
6860point+=1
6870IF board?point < 128 AND board?point>0 THEN minwhite=point:found=TRUE
6880ENDWHILE
6890point=25:found=FALSE
6900WHILE NOT found
6910point-=1
6920IF board?point > 128 THEN maxblack=point:found=TRUE
6930ENDWHILE
6940allpast=(minwhite>maxblack)
6950=allpast
6960
6970DEFPROCshowscore
6980LOCAL text$,x,y,button,screen
6990IF evaldisplay$="ON" THEN
7000IF whiteturn THEN col$="black" ELSE col$="white"
7010current_score=FNevaluateboard(col$,board,whitepieces,blackpieces,barwhite,barblack,winner$)
7020text$=col$+" "+STR$current_score
7030FOR screen = 1 TO 2
7040PROCdrawtextbox(dicepanel(),text$,ivory,black)
7050PROCswitch_update_bank
7060NEXT screen
7070ENDIF
7080ENDIF
7090ENDPROC
7100
7110
7120DEFPROCcomputerplay(col$)
7130LOCAL move,moveover,p,s
7140CASE col$ OF
7150WHEN "white":whitebearing=FALSE
7160WHEN "black":blackbearing=FALSE
7170ENDCASE
7180REM SYS "Hourglass_On"
7190FOR p = 1 TO 4
7200panelactive(p)=FALSE
7210NEXT p
7220PROCmovepanel:PROCdrawpanels
7230moveover=FALSE
7240PROCcomputer_offer(col$): IF NOT gameinprogress THEN ENDPROC
7250MOUSE OFF
7260PROCdice: dicerolled=TRUE:firstpair=TRUE:PROCdicepanel
7270IF FNopening_move(col$) THEN PROCfind_opening_moves(col$)
7280IF double THEN firstpair=TRUE:diceavailable=2
7290REPEAT
7300IF FNlegalmoveavailable(col$) THEN
7310IF NOT allpast THEN allpast = FNallpast
7320move = FNchoosecomputermove(col$)
7330startpoint = legalmoves(1,move)
7340endpoint = legalmoves(2,move)
7350diceused = legalmoves(3,move)
7360barmove = legalmoves(4,move)
7370bearing = legalmoves(5,move)
7380dice(diceused) +=128
7390diceavailable -= 1
7400PROCcomputerdrag(col$,startpoint,endpoint,FALSE)
7410PROCexecutemove(col$,startpoint,endpoint)
7420PROCdicepanel
7430ELSE
7440MOUSE ON:PROCcantmove(col$,"")
7450moveover=TRUE
7460ENDIF
7470IF diceavailable=0 THEN
7480IF double THEN
7490IF firstpair THEN
7500diceavailable=2:firstpair=FALSE:dice(1)-=128:dice(2)-=128
7510ELSE
7520moveover=TRUE
7530ENDIF
7540ELSE
7550moveover=TRUE
7560ENDIF
7570ENDIF
7580UNTIL NOT gameinprogress OR moveover
7590dicerolled=FALSE:PROCdicepanel
7600IF FNopening_move(col$) THEN
7610IF col$="white" THEN whiteopening=FALSE ELSE blackopening=FALSE
7620ENDIF
7630REM REPEAT UNTIL GET:REM **************************
7640ENDPROC
7650
7660DEFFNopening_move(col$)
7670CASE col$ OF
7680WHEN "white": = whiteopening
7690WHEN "black": = blackopening
7700ENDCASE
7710
7720DEFPROChumanplay(col$)
7730MOUSE ON
7740LOCALx,y,button,startpoint,endpoint,legal,moveover,s
7750CASE col$ OF
7760WHEN "white":whitebearing=FALSE
7770WHEN "black":blackbearing=FALSE
7780ENDCASE
7790REM SYS "Hourglass_On"
7800moveover=FALSE
7810LOCAL pressed, panno: pressed = FALSE: panno = 0
7820panelactive(1) = TRUE
7830IF doubleturn$ ="either" OR doubleturn$ = col$ THEN panelactive(2) = TRUE
7840panelactive(3) = FALSE
7850panelactive(4) = TRUE
7860PROCmovepanel:PROCdrawpanels
7870REM look for mouse presses in panel
7880REM SYS "Hourglass_Off"
7890IF NOT startset THEN
7900REPEAT
7910panno = FNgetpanel
7920IF panno = 2 THEN PROCofferdouble(col$)
7930IF panno = 4 THEN
7940IF FNsurebox("") THEN gameinprogress=FALSE:gamecompleted=FALSE
7950MOUSE RECTANGLE 0,0,1239,1023
7960ENDIF
7970UNTIL NOT gameinprogress OR panno = 1
7980ENDIF
7990IF NOT gameinprogress THEN ENDPROC
8000panelactive(1)=FALSE:panelactive(2)=FALSE:panelactive(4)=FALSE:PROCdrawpanels
8010REM game may be over due to refused offer so
8020IF gameinprogress THEN
8030PROCdice:dicerolled=TRUE:firstpair=TRUE:PROCdicepanel
8040IF double THEN firstpair=TRUE:diceavailable=2
8050REPEAT
8060IF FNlegalmoveavailable(col$) THEN
8070IF NOT allpast THEN allpast = FNallpast
8080REPEAT
8090startpoint=0:endpoint=0
8100*FX15
8110MOUSE x,y,button
8120IF button THEN startpoint = FNpointxy(x,y)
8130IF FNlegalstart(startpoint,col$) THEN
8140endpoint =FNdrag(col$,x,y)
8150legal= FNlegalmove(col$,startpoint,endpoint)
8160ELSE
8170legal=FALSE
8180ENDIF
8190UNTIL legal
8200PROCexecutemove(col$,startpoint,endpoint)
8210PROCdicepanel
8220ELSE
8230PROCcantmove(col$,"")
8240moveover=TRUE
8250ENDIF
8260IF diceavailable=0 THEN
8270IF double THEN
8280IF firstpair THEN
8290diceavailable=2:firstpair=FALSE:dice(1)-=128:dice(2)-=128
8300ELSE
8310moveover=TRUE
8320ENDIF
8330ELSE
8340moveover=TRUE
8350ENDIF
8360ENDIF
8370UNTIL NOT gameinprogress OR moveover
8380ENDIF
8390dicerolled=FALSE:PROCdicepanel
8400ENDPROC
8410
8420DEFFNshowcol(col$)
8430IF col$="white" THEN ="WHITE" ELSE ="BLACK"
8440
8450DEFPROCofferdouble(col$)
8460LOCAL oppcol$,offset,tempbox():DIM tempbox(4)
8470tempbox()=surebox():offset=60
8480surebox(2)-=240:surebox(4)-=240:surebox(1)-=offset:surebox(3)-=offset
8490IF col$="white" THEN oppcol$="black" ELSE oppcol$="white"
8500IF FNsurebox("OFFER DOUBLE?") THEN
8510IF FNcomputercol(oppcol$) THEN
8520doubled=FNdouble_accepted(oppcol$)
8530ELSE
8540doubled = FNsurebox("ACCEPT DOUBLE?")
8550ENDIF
8560IF doubled THEN
8570PROCaccept_double(oppcol$)
8580ELSE
8590double_refused=TRUE
8600PROCwinner(col$)
8610ENDIF
8620ENDIF
8630surebox()=tempbox()
8640ENDPROC
8650
8660DEFPROCcomputer_offer(col$)
8670MOUSE ON
8680IF NOT (doubleturn$=col$ OR doubleturn$="either") THEN ENDPROC
8690LOCAL oppcol$,offset,tempbox():DIM tempbox(4)
8700tempbox()=surebox():offset=60
8710surebox(2)-=240:surebox(4)-=240:surebox(1)-=offset:surebox(3)-=offset
8720IF col$="white" THEN oppcol$="black" ELSE oppcol$="white"
8730IF current_score < 8 - double_threshold THEN
8740REM offer double
8750IF FNcomputercol(oppcol$) THEN
8760PROCcantmove(col$," "+FNshowcol(col$)+" DOUBLES")
8770doubled = FNdouble_accepted(oppcol$)
8780ELSE
8790doubled = FNsurebox("ACCEPT DOUBLE?")
8800ENDIF
8810IF doubled THEN
8820PROCaccept_double(oppcol$)
8830ELSE
8840double_refused=TRUE
8850PROCwinner(col$)
8860ENDIF
8870ENDIF
8880surebox()=tempbox()
8890ENDPROC
8900
8910DEFFNcomputercol(col$)
8920=(col$="white" AND whiteplayer$="COMPUTER") OR (col$="black" AND blackplayer$="COMPUTER")
8930
8940DEFFNdouble_accepted(col$)
8950LOCAL threshold,ownpieces,opppieces
8960IF col$="white" THEN ownpieces = whitepieces: opppieces = blackpieces ELSE ownpieces = blackpieces: opppieces = whitepieces
8970threshold = -double_threshold -8
8980IF allpast THEN threshold = -16
8990IF opppieces < 10 THEN threshold = 0
9000IF current_score < threshold THEN
9010double_refused=TRUE
9020PROCcantmove(col$," "+FNshowcol(col$)+" REFUSES")
9030=FALSE
9040ELSE
9050=TRUE
9060ENDIF
9070
9080DEFPROCaccept_double(col$)
9090SYS "Hourglass_On"
9100IF doublecube = 64 THEN doublecube = 2 ELSE doublecube = 2*doublecube
9110IF doublecube = 64 THEN doubleturn$="neither" ELSE doubleturn$=col$
9120panelactive(2)=FALSE:doubled=TRUE
9130IF FNcomputercol(col$) THEN PROCcantmove(col$," "+FNshowcol(col$)+" ACCEPTS")
9140PROCshadow_drawbar
9150PROCdraw_double_panel
9160SYS "Hourglass_Off"
9170ENDPROC
9180
9190DEFFNlegalstart(point,col$)
9200LOCAL legal,bar
9210IF point = 0 THEN = FALSE
9220REM check for pieces on bar
9230IF FNpiecesonbar(col$) THEN
9240IF point = 99 THEN =TRUE ELSE = FALSE
9250ENDIF
9260REM Otherwise point is "legal" if pieces of correct colour are present on it
9270legal=FALSE
9280CASE col$ OF
9290WHEN "white": IF board?point >0 AND board?point<128 THEN legal=TRUE
9300WHEN "black": IF board?point >128 THEN legal = TRUE
9310ENDCASE
9320=legal
9330
9340DEFFNpiecesonbar(col$)
9350LOCAL bar:bar=FALSE
9360CASE col$ OF
9370WHEN "white":
9380IF barwhite >0 THEN
9390bar=TRUE
9400ENDIF
9410WHEN "black":
9420IF barblack >0 THEN
9430bar=TRUE
9440ENDIF
9450ENDCASE
9460=bar
9470
9480
9490DEFFNpointxy(x,y)
9500REM returns point number corresponding to screen co-ordinates
9510REM or 99 for click on bar or else 0
9520LOCAL barleft,topboard,bottomboard,point,xp,yp,found
9530barleft = (boardsize-barwidth)/2
9540IF x > barleft AND x < barleft+barwidth THEN =99
9550IF y > boardsize-bordersize-pointheight AND x < boardsize THEN topboard = TRUE ELSE topboard = FALSE
9560IF y < bordersize+pointheight AND x < boardsize THEN bottomboard = TRUE ELSE bottom = FALSE
9570IF NOT (topboard OR bottomboard) THEN =0
9580found = FALSE
9590IF topboard THEN point = 0 ELSE point = 12
9600WHILE NOT found AND point <24
9610point+=1
9620PROCstartpoint(point,xp,yp)
9630IF x> xp AND x < xp+pointwidth THEN found = TRUE
9640ENDWHILE
9650IF (topboard AND point>12) OR (bottomboard AND point>24) THEN =0 ELSE = point
9660
9670DEFFNdrag(col$,startx,starty)
9680REM allows player to drag circle from starting point
9690REM returns point number of position where mouse is released
9700LOCAL x,y,button,r:r=piecesize/2
9710GCOL 3,1
9720MOUSE x,y,button
9730IF button THEN CIRCLE startx,starty,r
9740WHILE button
9750MOUSE ON 2
9760*FX15
9770MOUSE x,y,button
9780CIRCLE startx,starty,r
9790IF button THEN
9800CIRCLE x,y,r
9810startx=x:starty=y
9820ENDIF
9830ENDWHILE
9840MOUSE ON 1
9850IF startx>boardsize THEN =111 ELSE =FNpointxy(startx,starty)
9860REM 111 code for bearing off move
9870
9880DEFPROCcomputerdrag(col$,startpoint,endpoint,hitmove)
9890LOCAL startx,starty,endx,endy,npstart,npend,offset,xstep,ystep,x,y,steps,step,r,oldx1,oldy1,oldx2,oldy2,box(),oppcol$,sprite$,oldsprite1$,oldsprite2$,k,i
9900VDU 24,0;0;1024;1023;
9910k=20
9920IF col$="white" THEN oppcol$="black" ELSE oppcol$="white"
9930DIM box(4)
9940REM PROCget_sprite("temp",gamebox())
9950r=piecesize/2
9960IF startpoint = 99 THEN
9970IF col$="white" THEN npstart = barwhite ELSE npstart = barblack
9980ELSE
9990npstart = board?startpoint MOD 128
10000ENDIF
10010IF hitmove THEN
10020IF col$="white" THEN npend = barwhite ELSE npend = barblack
10030ELSE
10040npend = board?endpoint MOD 128
10050ENDIF
10060IF npstart>6 THEN npstart=6
10070IF npend <6 THEN npend +=1
10080IF npend>6 THEN npend=6
10090IF npend = 2 AND FNpointstate(endpoint) = ("one"+oppcol$) THEN npend=1
10100PROCfindpiecepoint(col$,npstart,startpoint,startx,starty)
10110PROCfindpiecepoint(col$,npend,endpoint,endx,endy)
10120steps = INT(36*FNdistance(startx,starty,endx,endy)/480)
10130xstep=(endx-startx)/steps
10140ystep=(endy-starty)/steps
10150IF NOT hitmove THEN
10160IF startpoint <99 THEN
10170board?startpoint=board?startpoint-1
10180IF board?startpoint=128 THEN board?startpoint=0
10190ELSE
10200CASE col$ OF
10210WHEN "white": barwhite -=1
10220WHEN "black": barblack -=1
10230ENDCASE
10240ENDIF
10250ENDIF
10260REM GCOL 3,1
10270REM CIRCLE startx,starty,r
10280startx-=r:starty-=r
10290*FX 112,1
10300*FX 113,1
10310update_bank=1:display_bank=1
10320IF startpoint = 99 THEN
10330PROCshadow_drawbar
10340ELSE
10350PROCshadow_drawpoint(startpoint,FALSE)
10360ENDIF
10370PROCgrabarea("temp1",startx,starty,k)
10380MOVE startx,starty
10390IF NOT hitmove THEN
10400PROCplot_sprite(col$,8)
10410FOR i = 1 TO 8:PROCswitch_display_bank:PROCdelay(10):NEXT i
10420ENDIF
10430oldx1=startx:oldy1=starty
10440PROCswitch_update_bank
10450PROCgrabarea("temp2",startx,starty,k)
10460MOVE startx,starty
10470IF NOT hitmove THEN PROCplot_sprite(col$,8)
10480oldx2=startx:oldy2=starty
10490PROCswitch_update_bank
10500oldsprite1$="temp1":oldsprite2$="temp2"
10510PROCswitch_display_bank
10520REM
10530FOR step = 1 TO steps + 1
10540IF update_bank=1 THEN
10550sprite$=oldsprite1$
10560MOVE oldx1-k,oldy1-k
10570ELSE
10580sprite$=oldsprite2$
10590MOVE oldx2-k,oldy2-k
10600ENDIF
10610PROCplot_sprite(sprite$,0)
10620IF step < steps + 1 THEN
10630startx+=xstep:starty+=ystep
10640ENDIF
10650IF update_bank = 1 THEN
10660oldx1=startx: oldy1 = starty
10670ELSE
10680oldx2=startx: oldy2 = starty
10690ENDIF
10700sprite$=FNupdate_sprite
10710PROCgrabarea(sprite$,startx,starty,k)
10720IF update_bank = 1 THEN oldsprite1$=sprite$ ELSE oldsprite2$=sprite$
10730MOVE startx,starty
10740PROCplot_sprite(col$,8)
10750PROCswitch_display_bank
10760PROCswitch_update_bank
10770REM PROCdelay(1)
10780NEXT step
10790PROCswitch_display_bank
10800REM
10810VDU 26
10820ENDPROC
10830
10840DEFFNdistance(x1,y1,x2,y2)
10850=SQR((x1-x2)^2+(y1-y2)^2)
10860
10870DEFPROCgrabarea(sprite$,x,y,k)
10880MOVE x-k,y-k:MOVE x+piecesize+k,starty+piecesize+k
10890SYS "OS_SpriteOp",256+14,spritearea,sprite$
10900ENDPROC
10910
10920
10930DEFFNupdate_sprite
10940="temp"+STR$update_bank
10950
10960DEFPROCfindpiecepoint(col$,piece,point,RETURN x,RETURN y)
10970LOCAL offset
10980IF point = 111 THEN
10990x = boardsize + 64
11000y = boardsize/2
11010ENDPROC
11020ENDIF
11030IF point = 99 THEN
11040offset = (piece-0.5)*piecesize
11050CASE col$ OF
11060WHEN "white":
11070PROCstartpoint(7,x,y)
11080y =ytop-offset
11090WHEN "black"
11100PROCstartpoint(18,x,y)
11110y = ybottom + offset
11120ENDCASE
11130x+=pointwidth+barwidth/2
11140ELSE
11150PROCstartpoint(point,x,y)
11160x+= pointwidth/2
11170offset = (piece-0.50)*piecesize
11180IF point < 13 THEN y = ytop-offset ELSE y =ybottom+offset
11190ENDIF
11200ENDPROC
11210
11220DEFFNlegalmoveavailable(col$)
11230REM Called at start of move to check that move can be made
11240REM also creates list of legal moves for use by computer version
11250LOCAL dice,roll,from,to,using,dest,code
11260nlegal=0: bearingpossible=FALSE
11270IF FNopening_move(col$) THEN IF FNset_opening_move(col$) THEN =TRUE
11280REM check barmove
11290IF FNpiecesonbar(col$) THEN barmove = TRUE ELSE barmove = FALSE
11300IF barmove THEN
11310FOR dice = 1 TO dice(0)
11320roll=dice(dice)
11330IF roll < 128 THEN
11340IF FNdestinationOK(99,roll,col$,dest) THEN PROCaddlegal(99,dest,dice)
11350ENDIF
11360NEXT dice
11370ELSE
11380FOR from = 1 TO 24
11390code = board?from
11400IF (col$="white" AND code>0 AND code<128) OR (col$="black" AND code>128) THEN
11410FOR dice = 1 TO dice(0)
11420roll=dice(dice)
11430IF roll < 128 THEN
11440IF FNdestinationOK(from,roll,col$,dest) THEN PROCaddlegal(from,dest,dice)
11450ENDIF
11460NEXT dice
11470ENDIF
11480NEXT from
11490ENDIF
11500REM PRINT TAB(0,0);nlegal
11510=nlegal
11520
11530DEFFNset_opening_move(col$)
11540REM returns TRUE if destination point clear of opposition
11550REM so that computer can usually make set moves if
11560REM the second to move
11570LOCAL ok,oppcol$,from,to
11580ok=TRUE
11590IF col$="white" THEN oppcol$="black" ELSE oppcol$="white"
11600bearing=FALSE:barmove=FALSE:movefrombar=FALSE
11610dice = dice(0)+1-diceavailable
11620IF diceavailable=2 THEN ok=FNproject_opening_move(col$,2,from,to)
11630IF NOT ok THEN =FNnotok(col$)
11640ok=FNproject_opening_move(col$,dice,from,to)
11650IF NOT ok THEN =FNnotok(col$)
11660PROCaddlegal(from,to,dice)
11670=TRUE
11680
11690DEFFNnotok(col$)
11700CASE col$ OF
11710WHEN "white":whiteopening=FALSE
11720WHEN "black":blackopening=FALSE
11730ENDCASE
11740nlegal=0
11750REM PRINT TAB(0,0);col$;" ";diceavailable,dice
11760=FALSE
11770
11780DEFFNproject_opening_move(col$,dice,RETURN from,RETURN to)
11790LOCAL ok,oppcol$,d
11800IF double AND NOT firstpair THEN d=dice+2 ELSE d=dice
11810from = openings(d)
11820IF col$="white" THEN to=from+dice(dice) ELSE to=from-dice(dice)
11830IF col$="white" THEN oppcol$="black" ELSE oppcol$="white"
11840IF FNpointpieces(oppcol$,to,board)=0 THEN ok=TRUE ELSE ok=FALSE
11850=ok
11860
11870DEFPROCcantmove(col$,message$)
11880VDU7
11890PROCgrabbox(cantbox(),"temp")
11900PROCcantbox(col$,message$)
11910PROCrestorebox(cantbox(),"temp")
11920dicerolled=FALSE:PROCdicepanel
11930ENDPROC
11940
11950
11960DEFPROCaddlegal(from,to,using)
11970nlegal+=1
11980legalmoves(1,nlegal) = from
11990IF bearing THEN bearingpossible=TRUE:legalmoves(2,nlegal) = 111 ELSE legalmoves(2,nlegal) = to
12000legalmoves(3,nlegal) = using
12010legalmoves(4,nlegal) = barmove
12020legalmoves(5,nlegal) = bearing
12030ENDPROC
12040
12050DEFFNdestinationOK(startpoint,roll,col$,RETURN dest)
12060LOCAL state$,diff,legal,d,dicefound
12070legal=FALSE
12080REM check for moving off bar
12090IF startpoint = 99 THEN
12100movefrombar=TRUE
12110CASE col$ OF
12120WHEN "white": startpoint=0
12130WHEN "black": startpoint=25
12140ENDCASE
12150ELSE
12160movefrombar=FALSE
12170ENDIF
12180REM check for destination on board
12190IF col$ ="white" THEN dest = startpoint+roll ELSE dest=startpoint-roll
12200IF dest <1 OR dest > 24 THEN
12210REM PRINT TAB(0,0);startpoint,dest
12220bearing = FNbearingcheck(startpoint,dest,col$)
12230IF bearing THEN = TRUE ELSE = FALSE
12240ELSE
12250bearing=FALSE
12260ENDIF
12270REM check for state of destination
12280state$ = FNpointstate(dest)
12290IF (state$="onewhite" AND col$="black") OR (state$="oneblack" AND col$="white") THEN
12300barmove=TRUE:=TRUE
12310ELSE
12320barmove=FALSE
12330ENDIF
12340IF state$ ="empty" OR state$=col$ OR RIGHT$(state$,5)=col$ THEN = TRUE
12350=FALSE
12360
12370DEFFNbearingcheck(start,dest,col$)
12380LOCAL possible,point,maxpoint,minpoint
12390IF (col$="white" AND dest<0) OR (col$="black" AND dest>24) THEN =FALSE
12400IF NOT FNbearingpossible(col$) THEN =FALSE
12410possible=FALSE
12420CASE col$ OF
12430WHEN "black":
12440IF dest=0 THEN
12450possible =TRUE: REM exact number
12460ELSE
12470maxpoint=0
12480FOR point=1 TO 6
12490IF board?point>128 AND point>maxpoint THEN maxpoint=point
12500NEXT point
12510IF maxpoint <FNmindice AND maxpoint = start THEN possible=TRUE
12520ENDIF
12530WHEN "white":
12540IF dest=25 THEN
12550possible=TRUE
12560ELSE
12570minpoint=25
12580FOR point=18 TO 24
12590IF board?point>0 AND board?point<128 AND point<minpoint THEN minpoint=point
12600NEXT point
12610IF (25-minpoint) <FNmindice AND minpoint = start THEN possible=TRUE
12620ENDIF
12630ENDCASE
12640=possible
12650
12660DEFFNmindice
12670REM returns number of smallest dice available
12680LOCAL dice,roll,min
12690min=6
12700FOR dice = 1 TO dice(0)
12710roll=dice(dice)
12720IF roll <128 THEN
12730IF roll<min THEN min=roll
12740ENDIF
12750NEXT dice
12760=min
12770
12780DEFFNbearingpossible(col$)
12790REM Checks whether all pieces within home board
12800LOCAL point,possible: possible = TRUE
12810CASE col$ OF
12820WHEN "white":
12830IF barwhite >0 THEN
12840possible=FALSE
12850ELSE
12860point=0
12870REPEAT
12880point+=1
12890IF board?point>0 AND board?point<128 THEN possible=FALSE
12900UNTIL point=18 OR NOT possible
12910ENDIF
12920WHEN "black":
12930IF barblack>0 THEN
12940possible=FALSE
12950ELSE
12960point=6
12970REPEAT
12980point+=1
12990IF board?point>128 THEN possible =FALSE
13000UNTIL point=24 OR NOT possible
13010ENDIF
13020ENDCASE
13030=possible
13040
13050DEFFNlegalmove(col$,startpoint,endpoint)
13060LOCAL state$,diff,legal,d,dicefound
13070legal=0:dicefound=0
13080REPEAT
13090legal+=1
13100IF legalmoves(1,legal)=startpoint AND legalmoves(2,legal) = endpoint THEN
13110dicefound = legalmoves(3,legal): barmove = legalmoves(4,legal): bearing=legalmoves(5,legal)
13120ENDIF
13130UNTIL dicefound OR legal = nlegal
13140IF dicefound THEN
13150dice(dicefound) +=128
13160diceavailable -= 1
13170ENDIF
13180= dicefound
13190
13200DEFFNpointstate(point)
13210IF board?point MOD 128 =0 THEN ="empty"
13220IF board?point =1 THEN ="onewhite"
13230IF board?point =129 THEN ="oneblack"
13240IF board?point>128 THEN ="black"
13250="white"
13260
13270DEFPROCexecutemove(col$,start,end)
13280LOCAL screen,oppcol$
13290IF col$="white" THEN oppcol$="black" ELSE oppcol$="white"
13300IF bearing THEN PROCbearoffpiece(col$,start):ENDPROC
13310IF movefrombar AND NOT FNcomputercol(col$) THEN
13320CASE col$ OF
13330WHEN "white": barwhite -=1
13340WHEN "black": barblack -=1
13350ENDCASE
13360PROCshadow_drawbar
13370ELSE
13380IF NOT FNcomputercol(col$) THEN
13390board?start=board?start-1
13400IF board?start=128 THEN board?start=0
13410ENDIF
13420ENDIF
13430IF NOT barmove THEN
13440IF col$="black" AND board?end=0 THEN board?end=128
13450board?end=board?end+1
13460ELSE
13470board?end=1
13480IF col$="black" THEN board?end += 128
13490ENDIF
13500FOR screen = 1 TO 2
13510PROCswitch_update_bank
13520PROCdrawpoint(start)
13530PROCdrawpoint(end)
13540PROCswitch_display_bank
13550NEXT screen
13560IF barmove THEN
13570SOUND 1,-10,70,5
13580PROCcomputerdrag(oppcol$,end,99,TRUE)
13590CASE col$ OF
13600WHEN "white": barblack+=1: board?end=1
13610WHEN "black": barwhite+=1: board?end=129
13620ENDCASE
13630PROCshadow_drawbar
13640ENDIF
13650REM IF movefrombar THEN PROCshadow_box(barbox())
13660ENDPROC
13670
13680DEFPROCcantbox(col$,message$)
13690IF message$="" THEN
13700IF col$="white" THEN message$ ="WHITE" ELSE message$="BLACK"
13710message$+=" CANNOT MOVE"
13720ENDIF
13730SYS "Hourglass_Smash"
13740PROCdisplaybox(cantbox(),message$)
13750ENDPROC
13760
13770DEFPROCdisplaybox(cantbox(),message$)
13780LOCAL x,y,button,xm,ym
13790PROCshowbox(cantbox(),black,ivory)
13800button=0:*FX15
13810xm = cantbox(1)+128
13820ym = cantbox(2)+240
13830GCOL blue
13840VDU 5
13850MOVE xm,ym: PRINT message$
13860GCOL red
13870MOVE cantbox(1)+128,cantbox(2)+100:PRINT "Press any button"
13880REPEAT
13890MOUSE x,y,button
13900UNTIL button
13910VDU 4
13920MOUSE RECTANGLE 0,0,1239,1023
13930ENDPROC
13940
13950DEFPROCshowbox(box(),bordercol,boxcol)
13960LOCAL border:border=32
13970GCOL bordercol
13980RECTANGLE FILL box(1),box(2),box(3)-box(1),box(4)-box(2)
13990GCOL boxcol
14000RECTANGLE FILL box(1)+border,box(2)+border,box(3)-box(1)-2*border,box(4)-box(2)-2*border
14010MOUSE RECTANGLE box(1),box(2),box(3)-box(1),box(4)-box(2)
14020ENDPROC
14030
14040DEFPROCwindisplay(m1$,m2$,m3$)
14050LOCAL border,x,y,ystep,centresize,button
14060border=32:centresize=(optbox(3)-optbox(1))DIV16
14070PROCgrabbox(optbox(),"temp")
14080PROCshowbox(optbox(),black,white)
14090VDU5
14100ystep=3*border
14110x=optbox(1): y = optbox(4)-ystep
14120GCOL black
14130MOVE x,y:PRINT FNcentrel(m1$,centresize)
14140y-=ystep: GCOL red
14150MOVE x,y:PRINT FNcentrel(m2$,centresize)
14160y-=ystep:GCOL blue
14170MOVE x,y:PRINT FNcentrel(m3$,centresize)
14180y-=ystep: GCOL black
14190MOVE x,y:PRINT FNcentrel("Press any button",centresize)
14200VDU4
14210*FX15
14220REPEAT:MOUSEx,y,button:UNTIL button
14230PROCrestorebox(optbox(),"temp")
14240MOUSE RECTANGLE 0,0,1239,1023
14250ENDPROC
14260
14270DEFFNcentrel(text$,space)
14280REM adds blanks to left of text$ to centre in space
14290LOCAL l,a
14300l=LEN(text$):a=(space-l) DIV 2
14310=STRING$(a," ")+text$
14320
14330DEFFNsurebox(message$)
14340LOCAL yespanel(),nopanel(),border,button,sure,decision
14350border=32
14360DIM yespanel(4),nopanel(4)
14370yespanel(1)=surebox(1)+70:yespanel(2)=surebox(2)+100:yespanel(3)=yespanel(1)+100:yespanel(4)=yespanel(2)+80
14380nopanel()=yespanel():nopanel(1)+=130:nopanel(3)+=130
14390PROCgrabbox(surebox(),"temp2")
14400PROCshowbox(surebox(),midgrey,white)
14410PROCdrawtextbox(yespanel(),"YES",ivory,red)
14420PROCdrawtextbox(nopanel(),"NO",ivory,red)
14430GCOL blue:VDU7
14440VDU5
14450IF message$="" THEN message$="ARE YOU SURE?"
14460MOVE surebox(1)+80,surebox(4)-80:PRINT message$
14470button=0:decision=FALSE
14480REPEAT
14490IF FNmouseinbox(yespanel(),button) THEN sure=TRUE:decision=TRUE
14500IF FNmouseinbox(nopanel(),button) THEN sure=FALSE:decision=TRUE
14510UNTIL decision
14520PROCrestorebox(surebox(),"temp2")
14530VDU4:MOUSE RECTANGLE 0,0,1239,1023
14540=sure
14550
14560
14570DEFPROCbearoffpiece(col$,start)
14580LOCAL winner$,s: winner$=""
14590CASE col$ OF
14600WHEN "white":
14610COLOUR white
14620whitebearing=TRUE
14630whitegamescore +=1
14640whitepieces -=1
14650IF whitepieces = 0 THEN winner$ =col$
14660FOR s = 1 TO 2
14670PRINT TAB(70,6);whitegamescore
14680PROCswitch_update_bank
14690NEXT s
14700WHEN "black":
14710COLOUR black
14720blackbearing=TRUE
14730blackgamescore +=1
14740blackpieces -=1
14750IF blackpieces = 0 THEN winner$ = col$
14760FOR s = 1 TO 2
14770PRINT TAB(70,15);blackgamescore
14780PROCswitch_update_bank
14790NEXT s
14800ENDCASE
14810IF NOT FNcomputercol(col$) THEN
14820board?start=board?start-1
14830IF board?start=128 THEN board?start=0
14840PROCshadow_drawpoint(start,FALSE)
14850ENDIF
14860REM When computer is bearing off, start point is redrawn
14870REM by PROCcomputerdrag
14880IF winner$ >"" THEN PROCwinner(winner$)
14890ENDPROC
14900
14910DEFPROCwinner(col$)
14920LOCAL message1$,message2$,message3$,winnings,bonus,winner$,loser$
14930IF doublecube = 64 AND doubleturn$="either" THEN winnings = 1 ELSE winnings = doublecube
14940bonus=FNwinbonus(col$,board)
14950winnings = winnings*bonus
14960IF col$="white" THEN winner$="WHITE":loser$="BLACK" ELSE winner$="BLACK":loser$="WHITE"
14970message1$=winner$+" WINS!"
14980CASE bonus OF
14990WHEN 1: message2$="STANDARD PAYOUT"
15000WHEN 2: message2$=loser$+" IS GAMMONED"
15010WHEN 3: message2$=loser$+" IS BACKGAMMONED"
15020ENDCASE
15030message3$=loser$+" PAYS �"+STR$winnings
15040PROCwindisplay(message1$,message2$,message3$)
15050IF col$="white" THEN whitemoney+=winnings:blackmoney-=winnings ELSE blackmoney+=winnings:whitemoney-=winnings
15060IF whitemoney < 0 OR blackmoney <0 THEN PROCbankrupt(loser$)
15070gameinprogress=FALSE
15080ENDPROC
15090
15100DEFPROCbankrupt(loser$)
15110LOCAL message$
15120PROCdelay(30):*FX15
15130message$=loser$+" IS BANKRUPT!"
15140PROCgrabbox(cantbox(),"temp")
15150PROCdisplaybox(cantbox(),message$)
15160PROCrestorebox(cantbox(),"temp")
15170MOUSE RECTANGLE 0,0,1239,1023
15180whitemoney=100:blackmoney=100
15190ENDPROC
15200
15210DEFFNwinbonus(col$,board)
15220IF double_refused THEN =1
15230REM Returns 2 for gammon, 3 for backgammon, otherwise 1
15240LOCAL bonus,point
15250CASE col$ OF
15260WHEN "white"
15270IF blackpieces < 15 THEN
15280bonus=1
15290ELSE
15300bonus=2
15310FOR point = 19 TO 24
15320IF FNpointpieces("black",point,board) THEN bonus=3
15330NEXT point
15340ENDIF
15350WHEN "black"
15360IF whitepieces <15 THEN
15370bonus =1
15380ELSE
15390bonus=2
15400FOR point = 1 TO 6
15410IF FNpointpieces("white",point,board) THEN bonus=3
15420NEXT point
15430ENDIF
15440ENDCASE
15450=bonus
15460
15470REM Computer strategy
15480REM =================
15490
15500DEFFNchoosecomputermove(col$)
15510LOCAL legal,value,max,nmax,move
15520IF nlegal=1 THEN =1
15530IF NOT bearingpossible AND (allpast OR FNopponentbearing(col$)) THEN
15540=FNmostdistantmove(col$)
15550ENDIF
15560IF bearingpossible THEN
15570IF FNnohomeblots(col$) THEN =FNchoosebearingmove(col$)
15580ENDIF
15590IF move>0 THEN =move
15600REM Evaluate possible moves and keep list of those with
15610REM equal maximum score. Then choose one at random
15620max = FNevaluatemove(1,col$)
15630nmax = 1: bestmoves(1) = 1:move=1
15640REM PRINT TAB(0,1);" "
15650REM PRINT TAB(0,1);col$;" ";1;" ";legalmoves(1,1);" ";max;" "
15660FOR legal = 2 TO nlegal
15670value=FNevaluatemove(legal,col$)
15680REM FOR i=1 TO 24:bestboard?i = newboard?i:NEXT
15690IF value > max THEN
15700max=value:nmax=1:bestmoves(1)=legal:move=legal
15710ELSE
15720IF value = max THEN
15730nmax+=1: bestmoves(nmax) = legal
15740ENDIF
15750ENDIF
15760REM PRINT TAB(0,legal);" "
15770REM PRINT TAB(0,legal);col$;" ";legal;" ";legalmoves(1,legal);" ";value;" "
15780NEXT legal
15790REM PRINT TAB(0,legal);" "
15800REM PRINT TAB(0,legal)nmax,max
15810REM IF nmax = 1 THEN move =bestmoves(1) ELSE move =bestmoves(RND(nmax))
15820REM PRINT TAB(0,0);SPC50;
15830REM PRINT TAB(0,0);"colour ";col$;" nlegal ";nlegal;" bestmove ";move;" value ";max
15840=move
15850
15860DEFFNplayerbearing(col$)
15870= ((col$="white" AND whitebearing) OR (col$="black" AND blackbearing))
15880
15890DEFFNopponentbearing(col$)
15900IF (col$="white" AND blackpieces<7) OR (col$="black" AND whitepieces<7) THEN = FALSE
15910=(col$="white" AND blackbearing) OR (col$="black" AND whitebearing)
15920
15930DEFFNmostdistantmove(col$)
15940REM returns legal move of piece most distant from home
15950LOCAL move,best,furthest,current
15960best = 1: furthest = legalmoves(1,1)
15970FOR move = 2 TO nlegal
15980current = legalmoves(1,move)
15990CASE col$ OF
16000WHEN "white": IF current < furthest THEN current = furthest:best=move
16010WHEN "black": IF current > furthest THEN current = furthest:best=move
16020ENDCASE
16030NEXT move
16040=best
16050
16060DEFFNnohomeblots(col$)
16070REM returns TRUE if no blots in home board that can be attacked
16080LOCAL start,end,point,blotscore,present
16090IF (col$="white" AND barblack) OR (col$="black" AND barwhite) THEN =FALSE
16100blotscore=0
16110IF col$="white" THEN start=19:end=24 ELSE start=1:end=6
16120FOR point=start TO end
16130present = FNpointpieces(col$,point,board)
16140IF present=1 THEN blotscore -= FNblotscore(col$,point,col$,barwhite,barblack,board,1,0,0)
16150NEXT point
16160REM PRINT TAB(0,0);" ";TAB(0,0);blotscore
16170=(blotscore=0)
16180
16190DEFFNchoosebearingmove(col$)
16200REM chooses bearing move that is furthest from the end of the board
16210LOCAL move,from,bestmove,bestmovefrom
16220bestmove=0
16230FOR move = 1 TO nlegal
16240IF legalmoves(5,move) THEN
16250from = legalmoves(1,move)
16260IF bestmove=0 THEN
16270bestmove=move:bestmovefrom=from
16280ELSE
16290CASE col$ OF
16300WHEN "white":IF from<bestmovefrom THEN bestmove=move:bestmovefrom=bestmovefrom
16310WHEN "black":IF from>bestmovefrom THEN bestmove=move:bestmovefrom=bestmovefrom
16320ENDCASE
16330ENDIF
16340ENDIF
16350NEXT move
16360REM PRINT TAB(0,1);" ";TAB(0,1);bestmove
16370=bestmove
16380
16390DEFFNevaluatemove(move,col$)
16400PROCprojectmove(move,col$)
16410=FNevaluateboard(col$,newboard,newwhitepieces,newblackpieces,newbarwhite,newbarblack,newwinner$)
16420
16430DEFPROCprojectmove(move,col$)
16440LOCAL point
16450FOR point=1 TO 24:newboard?point=board?point:NEXT point
16460start = legalmoves(1,move)
16470end = legalmoves(2,move)
16480diceused = legalmoves(3,move)
16490barmove = legalmoves(4,move)
16500bearing = legalmoves(5,move)
16510movefrombar = (start=99)
16520newwhitepieces = whitepieces
16530newblackpieces = blackpieces
16540newbarwhite = barwhite
16550newbarblack = barblack
16560newwinner$=""
16570IF bearing THEN PROCprojectbearing(col$,start):ENDPROC
16580IF movefrombar THEN
16590CASE col$ OF
16600WHEN "white": newbarwhite -=1
16610WHEN "black": newbarblack -=1
16620ENDCASE
16630ELSE
16640newboard?start=newboard?start-1
16650IF newboard?start=128 THEN newboard?start=0
16660ENDIF
16670IF barmove THEN
16680CASE col$ OF
16690WHEN "white": newbarblack +=1: newboard?end=1
16700WHEN "black": newbarwhite +=1: newboard?end=129
16710ENDCASE
16720ELSE
16730IF col$="black" AND newboard?end=0 THEN newboard?end=128
16740newboard?end=newboard?end+1
16750ENDIF
16760ENDPROC
16770
16780DEFPROCprojectbearing(col$,start)
16790newwinner$=""
16800CASE col$ OF
16810WHEN "white":
16820COLOUR white
16830newwhitepieces -=1
16840IF newwhitepieces = 0 THEN newwinner$ =col$
16850WHEN "black":
16860COLOUR black
16870newblackpieces -=1
16880IF newblackpieces = 0 THEN newwinner$ = col$
16890ENDCASE
16900newboard?start=newboard?start-1
16910IF newboard?start=128 THEN newboard?start=0
16920ENDPROC
16930
16940DEFFNevaluateboard(col$,board,whitepieces,blackpieces,barwhite,barblack,win$)
16950IF col$ = win$ THEN =playerwins
16960LOCAL score,wp,bp,whc,woc,bhc,boc: score = 0
16970PROCcount_board(board,wp,bp,whc,woc,bhc,boc)
16980CASE col$ OF
16990WHEN "white":
17000score = FNboardscore("white",board,col$,barwhite,barblack,wp,whc,woc,bhc,boc,whiteblots)-FNboardscore("black",board,col$,barwhite,barblack,bp,bhc,boc,whc,woc,blackblots)
17010score += barwhite*pieceonbar
17020score -= barblack*pieceonbar
17030score += (15-whitepieces)*pieceoffboard
17040score -= (15-blackpieces)*pieceoffboard
17050WHEN "black"
17060score = FNboardscore("black",board,col$,barwhite,barblack,bp,bhc,boc,whc,woc,blackblots)-FNboardscore("white",board,col$,barwhite,barblack,wp,whc,woc,bhc,boc,whiteblots)
17070score -= barwhite*pieceonbar
17080score += barblack*pieceonbar
17090score -= (15-whitepieces)*pieceoffboard
17100score += (15-blackpieces)*pieceoffboard
17110REM VDU7:PRINT TAB(0,1);" ";TAB(0,1);score
17120REM REPEAT UNTIL GET
17130ENDCASE
17140=score
17150
17160DEFPROCcount_board(board,RETURN whitepoints,RETURN blackpoints,RETURN white_hc,RETURN white_oc,RETURN black_hc,RETURN black_oc)
17170LOCAL point,whitepresent,blackpresent
17180whitepoints=0:blackpoints=0:white_hc=0:white_oc=0:black_hc=0:black_oc=0
17190FOR point = 1 TO 24
17200whitepresent = FNpointpieces("white",point,board)
17210whiteblots?point = (whitepresent = 1)
17220white_cover?point = (whitepresent > 1)
17230blackpresent = FNpointpieces("black",point,board)
17240blackblots?point = (blackpresent = 1)
17250black_cover?point = (blackpresent > 1)
17260IF whitepresent > 0 THEN
17270IF point<19 THEN whitepoints += whitepresent*point ELSE whitepoints +=whitepresent*pieceinhomeboard
17280IF whitepresent >1 THEN
17290IF point > 18 THEN white_hc+=1 ELSE IF point>12 THEN white_oc+=1
17300ENDIF
17310ENDIF
17320IF blackpresent > 0 THEN
17330IF point>6 THEN blackpoints += blackpresent*(25-point) ELSE blackpoints +=blackpresent*pieceinhomeboard
17340IF blackpresent >1 THEN
17350IF point < 7 THEN black_hc+=1 ELSE IF point<13 THEN black_oc+=1
17360ENDIF
17370ENDIF
17380NEXT point
17390ENDPROC
17400
17410DEFFNboardscore(col$,board,movecol$,barwhite,barblack,board_points,own_hc,own_oc,opp_hc,opp_oc,ownblots)
17420LOCAL point,present,score,blotscore,ntrapping,ntrapped,trapscore
17430blotscore=0:ntrapped=0:ntrapping=0:trapscore=0
17440score=board_points+own_hc*doubleinhomebonus+own_oc*doubleinouterbonus
17450FOR point = 1 TO 24
17460IF ownblots?point THEN blotscore += FNblotscore(col$,point,movecol$,barwhite,barblack,board,diceavailable,opp_hc,opp_oc)
17470CASE col$ OF
17480WHEN "white":
17490IF white_cover?point THEN
17500IF point>18 THEN
17510trapscore+=FNtrapbonus(col$,point,board,ntrapping)
17520ELSE
17530IF point >12 THEN trapscore+=FNtrapbonus(col$,point,board,ntrapping)
17540ENDIF
17550ENDIF
17560WHEN "black"
17570IF black_cover?point THEN
17580IF point <7 THEN
17590trapscore+=FNtrapbonus(col$,point,board,ntrapping)
17600ELSE
17610IF point <13 THEN trapscore+=FNtrapbonus(col$,point,board,ntrapping)
17620ENDIF
17630ENDIF
17640ENDCASE
17650REM PRINT TAB(0,point);point,present,score,blotscore
17660NEXT point
17670IF ntrapping >4 THEN trapscore = 2*trapscore
17680score+=trapscore
17690REM IF col$="white" THEN x=0 ELSE x=40
17700REM PRINT TAB(x,0)SPC60;
17710REM PRINT TAB(x,0);col$;" ";score;" ";trapscore,ntrapping
17720=INT(score+blotscore)
17730
17740DEFFNtrapbonus(col$,doublepoint,board,RETURN ntrapping)
17750REM awards points for enemy pieces inside doubled point
17760REM in home and outer boards
17770LOCAL point,oppcol$,bonus,tb,pp
17780IF FNplayerbearing(col$) THEN tp = bearingtrapbonus ELSE tp = trapbonus
17790bonus=0
17800IF col$="white" THEN oppcol$="black" ELSE oppcol$="white"
17810CASE col$ OF
17820WHEN "white":
17830bonus += barblack*tp
17840FOR point = doublepoint TO 24
17850bonus+= FNpointpieces(oppcol$,point,board)*tp
17860NEXT point
17870WHEN "black":
17880bonus += barwhite*tp
17890FOR point = 1 TO doublepoint
17900bonus+=FNpointpieces(oppcol$,point,board)*tp
17910NEXT point
17920ENDCASE
17930REM PRINT TAB(0,0);SPC30;TAB(0,0);col$,doublepoint,bonus:REPEAT UNTIL GET
17940IF bonus>0 THEN ntrapping +=1
17950=bonus
17960
17970
17980DEFFNblotscore(col$,blotpoint,movecol$,barwhite,barblack,board,diceleft,opp_hc,opp_oc)
17990REM penalty for blot depends on how advanced the point
18000REM and how many opponent within six points ahead
18010REM and covering of opponents home and outerboards
18020LOCAL blotscore,coverable,penalty,ahead,oppcover
18030IF allpast THEN =0
18040IF col$ <> movecol$ OR diceleft <2 THEN penalty = TRUE ELSE penalty=FALSE
18050REM blots always scored as penalties when evaluating opponents move
18060REM or when playing second dice
18070IF NOT penalty THEN
18080IF NOT FNcoverable_blot(col$,blotpoint,board,barblack,barwhite) THEN penalty = TRUE
18090ENDIF
18100REM also treated as penalties if playing the first dice and a
18110REM second one cannot cover the blot
18120IF NOT penalty THEN
18130CASE col$ OF
18140WHEN "white": blotscore = blotposweight*((blotpoint-1)DIV 6)+1
18150WHEN "black": blotscore = blotposweight*((25-blotpoint-1)DIV 6)+1
18160ENDCASE
18170ELSE
18180REM penalise blots
18190oppcover = 2*opp_hc + opp_oc
18200ahead = FNaheadofblot(col$,blotpoint,board,barblack,barwhite,oppcover,blotscore)
18210ENDIF
18220REM VDU7:PRINT TAB(0,0);SPC30;TAB(0,0);col$,blotpoint,blotscore:REPEAT UNTIL GET
18230=blotscore
18240
18250DEFFNaheadofblot(col$,blotpoint,board,barblack,barwhite,oppcover,RETURN blotscore)
18260LOCAL ahead, aheadpoint,point,blotneg,coverscore
18270IF (col$="white" AND blotpoint>12) OR (col$="black" AND blotpoint <13) THEN
18280coverscore=oppcover DIV 4
18290ELSE
18300coverscore=0
18310ENDIF
18320CASE col$ OF
18330WHEN "white":
18340IF blotpoint > 18 AND barblack>0 THEN ahead+=2
18350REM piece on bar counted double to deter hitting in home board
18360aheadpoint=blotpoint+6:IF aheadpoint >24 THEN aheadpoint = 24
18370FOR point = blotpoint TO aheadpoint
18380IF FNpointpieces("black",point,board)>0 THEN ahead+=1
18390NEXT point
18400IF ahead = 0 THEN blotneg =1 ELSE blotneg = blotnegweight
18410blotscore=(ahead+coverscore)*blotneg*((blotpoint-1) DIV 6)+1
18420WHEN "black":
18430IF blotpoint <7 AND barwhite>0 THEN ahead+=2
18440aheadpoint=blotpoint-6:IF aheadpoint <1 THEN aheadpoint = 1
18450FOR point = aheadpoint TO blotpoint
18460IF FNpointpieces("white",point,board)>0 THEN ahead+=1
18470NEXT point
18480IF ahead = 0 THEN blotneg =1 ELSE blotneg = blotnegweight
18490blotscore=(ahead+coverscore)*blotneg*((25-blotpoint-1) DIV 6)+1
18500ENDCASE
18510blotscore = -blotscore
18520=ahead
18530
18540DEFFNcoverable_blot(col$,blotpoint,board,barblack,barwhite)
18550LOCAL dicefree,startpoint,roll,present,ok,endpoint,state$,dummy
18560IF diceused = 1 THEN dicefree=2 ELSE dicefree=1
18570roll=dice(dicefree)
18580IF col$="white" THEN startpoint = blotpoint-roll ELSE startpoint=blotpoint+roll
18590IF startpoint <0 OR startpoint >24 THEN
18600ok=FALSE
18610ELSE
18620present = FNpointpieces(col$,startpoint,board)
18630IF present >0 AND present <> 2 THEN ok=TRUE ELSE ok=FALSE
18640REM if covering point has two pieces then covering would
18650REM create a blot!
18660ENDIF
18670REM If blot cannot be covered then check if it could be move out
18680REM of danger by second dice. The destination point must be
18690REM in the same state as in newboard and board
18700IF NOT ok THEN
18710IF col$="white" THEN endpoint = blotpoint+roll:oppcol$="black" ELSE endpoint = blotpoint-roll:oppcol$="black"
18720IF endpoint<0 OR endpoint>24 THEN
18730ok = FALSE
18740ELSE
18750state$=FNpointstate(endpoint)
18760IF RIGHT$(state$,5)=oppcol$ THEN =TRUE
18770IF state$="empty" OR state$=col$ THEN ok = NOT FNaheadofblot(col$,blotpoint,board,barblack,barwhite,0,dummy)
18780ENDIF
18790ENDIF
18800=ok
18810
18820DEFFNpointpieces(col$,point,board)
18830LOCAL pieces
18840pieces = board?point
18850IF pieces = 0 THEN =0
18860CASE col$ OF
18870WHEN "white":
18880IF pieces >128 THEN =0 ELSE = pieces
18890WHEN "black":
18900IF pieces <129 THEN =0 ELSE = pieces MOD 128
18910ENDCASE
18920
18930
18940DEFPROCinit_weightings
18950REM signed for player of current colour, opponent
18960REM pieces scored as negation of these
18970REM alter these to tweak the strategy
18980playerwins = 999
18990pieceinhomeboard = 19
19000pieceinawayboard = -2: REM ie opponent's home board
19010pieceoffboard = 30
19020pieceonbar = -5
19030doubleinhomebonus=3
19040doubleinouterbonus=2
19050trapbonus = 1 :REM bonus for piece inside doubled point
19060bearingtrapbonus = 2.5 :REM as above when also bearing off
19070double_threshold = 30
19080REM since all pieces score for how advanced they are on the board
19090REM hitting and advanced piece automatically incurs a substantial
19100REM benefit
19110blotnegweight = 2
19120blotposweight = 2
19130ENDPROC
19140
19150DEFPROCallpast_weightings
19160REM weightings reset when pieces pass each other
19170pieceinhomeboard = 30
19180pieceoffboard = 50
19190ENDPROC
19200
19210DEFPROCfind_opening_moves(col$)
19220LOCAL moves,n,i,j,dice1,dice2
19230dice1=dice(1):dice2=dice(2)
19240moves=0
19250REPEAT:moves+=1
19260UNTIL dice1 = opening_moves(1,moves) AND dice2=opening_moves(2,moves)
19270IF double THEN
19280FOR i=1 TO 4
19290CASE i OF
19300WHEN 1,2: j=3
19310WHEN 3,4: j=4
19320ENDCASE
19330openings(i)=FNopening_point(opening_moves(j,moves),col$)
19340REM PRINT TAB(0,i);i,openings(i)
19350NEXT i
19360ELSE
19370FOR i=1 TO 2
19380openings(i)=FNopening_point(opening_moves(i+2,moves),col$)
19390REM PRINT TAB(0,i);i,openings(i)
19400NEXT i
19410ENDIF
19420ENDPROC
19430
19440DEFFNopening_point(point,col$)
19450IF col$="black" THEN
19460=(25-point)
19470ELSE
19480=point
19490ENDIF
19500
19510DEFPROCinit_opening_moves
19520LOCAL move,i
19530RESTORE 19610
19540DIM opening_moves(4,21),openings(4)
19550FOR move=1 TO 21
19560FOR i=1 TO 4
19570READ opening_moves(i,move)
19580NEXT i
19590NEXT move
19600ENDPROC
19610DATA 3,1,17,19
19620DATA 6,1,12,17
19630DATA 4,2,17,19
19640DATA 5,3,17,19
19650DATA 6,5,1,7
19660DATA 6,4,1,7
19670DATA 6,3,1,7
19680DATA 6,2,12,18
19690DATA 5,1,12,19
19700DATA 4,1,12,19
19710DATA 2,1,12,19
19720DATA 5,4,12,12
19730DATA 5,2,12,12
19740DATA 4,3,12,12
19750DATA 3,2,12,12
19760DATA 6,6,1,12
19770DATA 5,5,12,17
19780DATA 4,4,1,12
19790DATA 3,3,17,19
19800DATA 2,2,12,19
19810DATA 1,1,17,19
19820
19830
19840REM End of computer strategy
19850REM ========================
19860
19870
19880DEFPROCswitch_display_bank
19890IF display_bank=1 THEN display_bank=2 ELSE display_bank=1
19900WAIT
19910OSCLI "FX 113,"+STR$display_bank
19920ENDPROC
19930
19940DEFPROCswitch_update_bank
19950IF update_bank=1 THEN update_bank=2 ELSE update_bank=1
19960WAIT
19970OSCLI "FX 112,"+STR$update_bank
19980ENDPROC
19990
20000DEFPROCshadow_box(box())
20010REM Copy screen area into shadow screen
20020PROCgrabbox(box(),"temp")
20030PROCswitch_update_bank
20040PROCrestorebox(box(),"temp")
20050PROCswitch_update_bank
20060ENDPROC
20070
�> <Backg$Dir>.Backgammon
#� Jonathan Evans, December 1989
%� (c) Archimedes World April 1992
(*FX200,1
2 �init
<�
F
�initgame
P�screen
Z�startgame
d �play
n� �
x�
�
���screen
�� screen
� update_bank=2:display_bank=2
�*FX113,2
�*FX112,2
�ș "Hourglass_On"
�� 128+black:�
�� screen = 1 � 2
��switch_update_bank
�
�board
�
�panel
��switch_display_bank
ȗ �
� screen
ș "Hourglass_Off"
"�
,
6
��init
@X=�(-�)
J� 140: � 23,0,10,32|
TPblackmoney=1000:whitemoney=1000:blackplayer$="COMPUTER":whiteplayer$="HUMAN"
^Dmidgrey = 9: lightgrey = 10: darkgrey = 11: black = 0: white = 7
h7green = 2: brown = 6: red = 1: blue = 4: ivory = 14
rJ� midgrey, 128,128,128: � darkgrey, 64,64,64: � lightgrey, 196,196,196
|<� green, 32,132,32: � brown, 148,50,52: � red,200,16,016
�/� 15,0,0,0:� 14,240,240,176: � dice colours
�d� board 24, initboard 24, bestboard 24,whiteblots 24,blackblots 24,white_cover 24,black_cover 24
��boardsize = 1024: bordersize = 48: barwidth = 72: pointwidth = (boardsize-2*bordersize-barwidth)/12: pointheight = 380: ytop = boardsize-bordersize-2: ybottom = bordersize+6: piecesize = 60
�P� whitethrowbox(4),blackthrowbox(4),gamebox(4),dice(2),showdice(4),barbox(4)
�kbarbox(1)=(boardsize-barwidth)/2:barbox(2)=0:barbox(3)=barbox(1)+barwidth:barbox(4)=barbox(4)+boardsize
��blackthrowbox(1)=bordersize+16:blackthrowbox(2)=bordersize+pointheight+16:blackthrowbox(3)=(boardsize-barwidth)/2-16:blackthrowbox(4)=boardsize-bordersize-pointheight-16
whitethrowbox(1)=(boardsize+barwidth)/2+4:whitethrowbox(2)=blackthrowbox(2):whitethrowbox(3)=boardsize-bordersize-4:whitethrowbox(4)=blackthrowbox(4)
�Ggamebox(1)=0:gamebox(2)=0:gamebox(3)=boardsize:gamebox(4)=boardsize
�*evaldisplay$="ON":double=�:firstpair=�
�� legalmoves(5,50):nlegal=0
�(� opttext$(5),pointbox(4),surebox(4)
�*surebox(1)=1240/3-32:surebox(2)=1024/3
�3surebox(3)=2*surebox(1):surebox(4)=2*surebox(2)
!� i = 1 � 5:� opttext$(i):� i
,� "WHITE","BLACK","MONEY","VALUE","QUIT"
s� optbox(4),cantbox(4): optbox(1)=1240/4:optbox(2)=1024/4:optbox(3)=optbox(1)+1024/2:optbox(4)=optbox(2)+1024/2
&4cantbox()=optbox():cantbox(2)+=80:cantbox(4)-=80
0 � bestmoves(40),newboard 24
:�initpieces
D�initpanels
N�init_weightings
X�init_opening_moves
b�init_sprites
lȠ 2
v*CHANNELVOICE 1 1
�*CHANNELVOICE 2 6
�*<Backg$Dir>.HAND3
�
ȗ � 1
��
�
���init_sprites
�spritesize% = 100*1024
�� spritearea spritesize%
�!spritearea = spritesize%
�spritearea!4=0
�spritearea!8=16
�spritearea!16=16
�<ș "OS_SpriteOp",256+10,spritearea,"<Backg$Dir>.sprites"
�
��initgame
Cwhiteturn=�:gameinprogress=�: whitegamescore=0:blackgamescore=0
*(barblack=0:barwhite = 0:dicerolled=�
4�initpanelactivity
>4doublecube = 64:doubleturn$ = "either":doubled=�
H,blackpieces=15:whitepieces=15:winner$=""
R3blackopening=�: whiteopening=�: current_score=0
\3allpast=�: allpast_weight=�: double_refused = �
f(display_bank=2:update_bank=2:*SHADOW
p!whitebearing=�:blackbearing=�
z�
�
���initpanels
�� panno
�+� initialise panels in right hand strip
��� paneltext$(4),panel(4),panels(4,4),panelactive(5),movepanel(4),dicepanel(4),optpanel(4),quitpanel(4),okpanel(4),panelbox(4)
�noptpanel(1)=optbox(1)+200:optpanel(2)=optbox(4)-112:optpanel(3)=optpanel(1)+240:optpanel(4)=optpanel(2)+50
�rquitpanel(1)=optbox(1)+60:quitpanel(2)=optbox(2)+50:quitpanel(3)=quitpanel(1)+300:quitpanel(4)=quitpanel(2)+80
�hokpanel(1)=quitpanel(1)+320:okpanel(2)=quitpanel(2):okpanel(3)=okpanel(1)+80:okpanel(4)=quitpanel(4)
�xpaneltext$(1)="ROLL DICE": paneltext$(2)="OFFER DOUBLE": paneltext$(3) = "SET OPTIONS": paneltext$(4) = "START GAME"
�Lpanel(1) = boardsize+16:panel(3)=panel(1)+200:panel(2) =320:panel(4)=400
�;dicepanel()=panel():dicepanel(2)+=100:dicepanel(4)+=100
�Qmovepanel(1)=panel(1):movepanel(3)=panel(3):movepanel(2)=730:movepanel(4)=780
�� panno = 1 � 4
panels(1,panno) = panel(1)
,panels(2,panno) = panel(2)-100*(panno-1)
panels(3,panno) = panel(3)
$,panels(4,panno) = panel(4)-100*(panno-1)
.� panno
8cpanelbox(1)=panels(1,4):panelbox(2)=panels(2,4):panelbox(3)=panels(3,1):panelbox(4)=panels(4,1)
B�
L
V
`��initpanelactivity
j-� sets up initial state of panel activity
tPpanelactive(1)=�: panelactive(2) = �: panelactive(3) = �: panelactive(4) = �
~�
�
�
���board
�&� draws board at start of new game
�� 128+black:�
�� i
�+� i = 1 � 24: board?i = initboard?i:� i
�v� FOR i = 1 TO 24: board?i = testboard?i:NEXT i:blackpieces=11:whitepieces=9:blackopening=FALSE:whiteopening=FALSE
�;� midgrey: ȓ Ȑ boardsize+8,0,1240-boardsize,boardsize
�*� brown: ȓ Ȑ 0,0,boardsize,boardsize
�W� green: ȓ Ȑ bordersize,bordersize,boardsize-2*bordersize, boardsize-2*bordersize
�U� black: ȓ bordersize,bordersize,boardsize-2*bordersize, boardsize-2*bordersize
!� bordersize,bordersize:� 0,0
3� bordersize,boardsize-bordersize:� 0,boardsize
3� boardsize-bordersize,bordersize:� boardsize,0
F� boardsize-bordersize,boardsize-bordersize: � boardsize,boardsize
(�drawpoints
2�drawbar
<�
F
P
Z��draw_inner_rects
d<� black outline rectangles to replace possible obscuring
n� by redrawing of points
x� width,height,barright
�� black
�/width = (boardsize-barwidth)/2 - bordersize
�(barright = width+bordersize+barwidth
�!height=boardsize-2*bordersize
�Ȗ
�)ȓ bordersize,bordersize,width,height
�Ȗ
�'ȓ barright,bordersize,width,height
��
�
���shadow_drawbar
��switch_display_bank
��drawbar
�switch_display_bank
�shadow_box(barbox())
�
"
,
��drawbar
6� barleft,x,y,xoff,yoff
@$barleft = (boardsize-barwidth)/2
J/� brown: ȓ Ȑ barleft,0,barwidth,boardsize
TP� black:ȓ (boardsize-barwidth)/2,bordersize,barwidth,boardsize-2*bordersize
^1� barblack>0 � �piecesonbar(barblack,"black")
h1� barwhite>0 � �piecesonbar(barwhite,"white")
r� draw doubleing cube
|&x = barleft+10: y = boardsize/2-20
�� ivory
�ȓ Ȑ x,y,54,54
�� black
�ȓ x,y,54,54
�7yoff = 36: � doublecube > 9 � xoff = 10 � xoff = 20
�� 5: � blue
�!� x+xoff,y+yoff:�; doublecube
�� 4
�5� IF gameinprogress THEN PROCshadow_box(barbox())
��
�
� ��piecesonbar(nopieces,col$)
�� piece,x,y
Ȏ col$ �
� "black":
�startpoint(18,x,y)
&(x+=pointwidth+barwidth/2-piecesize/2
0� "white":
:�startpoint(7,x,y)
D(x+=pointwidth+barwidth/2-piecesize/2
N�
X� piece = 1 � nopieces
b#offset = (piece-0.50)*piecesize
l
Ȏ col$ �
v
� "black"
�#y = ybottom +offset-piecesize/2
�� x,y:�plot_sprite(col$,8)
�
� "white"
� y = ytop -offset-piecesize/2
��x,y:�plot_sprite(col$,8)
��
�� piece
��
�
���drawpoints
�"� point,pointcolour,startpoint
�� point = 1 � 24
��drawpoint(point)
� point
�
!��shadow_drawpoint(point,mfb)
*� screen
4� mfb � �shadow_drawbar
>�switch_update_bank
H�drawpoint(point)
R�switch_display_bank
\�grabbox(pointbox(),"temp")
f�switch_update_bank
p"�restorebox(pointbox(),"temp")
z�switch_update_bank
��
�
���drawpoint(point)
�.� piece,pieces,piececol,offset,s$,r,screen
�� Draw point
�>� point <13 � offset = -pointheight � offset = pointheight
�>�startpoint(point,x,y):�green: ȓ Ȑ x,y,pointwidth,offset
�� point > 12 �
�Mpointbox(1)=x:pointbox(2)=y:pointbox(3)=x+pointwidth:pointbox(4)=y+offset
��
�Mpointbox(1)=x:pointbox(2)=y+offset:pointbox(3)=x+pointwidth:pointbox(4)=y
��
�A� point � 2 = 1 � pointcolour = lightgrey � pointcolour = red
� pointcolour
� x,y: � x+pointwidth,y
S� point < 13 � � 81,-pointwidth/2,-pointheight � � 81,-pointwidth/2,pointheight
$� Draw pieces on point
.pieces = board?point
8� pieces >0 �
BL� pieces >128 � piececol = black: pieces = pieces � 128 � piececol=white
Lr=piecesize/2
Vx+= pointwidth/2-r: piece=0
`0� piececol = white � s$="white" � s$="black"
j�: piece+=1
t#offset = (piece-0.50)*piecesize
~?� point < 13 � y = ytop - offset-r � y = ybottom + offset-r
�0� GCOL piececol: CIRCLE FILL x,y,piecesize/2
�B� IF piececol = white THEN GCOL black: CIRCLE x,y,piecesize/2
�� x,y: �plot_sprite(s$,8)
� � piece = pieces � piece = 6
�6� pieces >6 � �numberpile(pieces,x+r,y+r,piececol)
��
�a� GCOL black: RECTANGLE bordersize,bordersize,boardsize-2*bordersize, boardsize-2*bordersize
��draw_inner_rects
��
�
���startpoint(point,� x,� y)
�/� finds top left hand co-ordinates of point
:� point <13 � y = ytop � y = ybottom: point = 25-point
-x = boardsize-bordersize-point*pointwidth
� point > 6 � x-= barwidth
�
(
2��initpieces
<� point,pieces
F� testboard 24
P� point = 1 � 24
Z&� pieces: initboard?point = pieces
d� point
nE� 2,0,0,0,0,128+5,0,128+3,0,0,0,5,128+5,0,0,0,3,0,5,0,0,0,0,128+2
x� point = 1 � 24
�&� pieces: testboard?point = pieces
�� point
�E� 128+3,3,0,0,0,128+2,0,128+3,0,0,0,0,0,0,0,0,0,0,0,2,0,128+3,0,4
�barwhite=0:barblack=0
��
�
�!��numberpile(no,x,y,piececol)
�� nocol,xoff,yoff
�0yoff = 12: � no > 9 � xoff = -16 � xoff = -8
�6� piececol = black � nocol = white � nocol = black
�� 5: � nocol
�� x+xoff,y+yoff:�; no
�� 4
�
)� Mouse and sprite library procedures
")� ===================================
,
6/��drawtextbox(box(),text$,boxcol%,textcol%)
@'� Draws unfilled box colour boxcol%
J7� and centres text label printed in colour textcol%
T3� boxwidth%,boxheight%,textwidth%, textx, texty
^�5: � boxcol%
h3ȓ Ȑ box(1),box(2),box(3)-box(1),box(4)-box(2)
r8� black:ȓ box(1),box(2),box(3)-box(1),box(4)-box(2)
|!textwidth%=�(text$)*1280 � 80
�boxwidth% = box(3)-box(1)
� boxheight% = box(4) - box(2)
�-textx = box(1)+(boxwidth%-textwidth%) � 2
�+texty = box(2)+(boxheight%-16) � 2 + 16
�� textcol%
�� textx,texty
�� text$
��4
��
�
� ݤmouseinbox(box(),� button)
�?� Returns TRUE if mouse clicked inside box, otherwise FALSE
�3� Also returns variable holding value of button
� x,y,t
*FX15
ȗ x,y,button
&� button �
0
�delay(1)
:/� delay to give user time to release button
DE� x>= box(1) � x <= box(3) � y >= box(2) � y <= box(4) � = � � =�
N�
X=�
b�
l
v!��plot_sprite(sprite$,action)
�� Plots sprite using mask
�7ș "OS_SpriteOp",256+28,spritearea,sprite$,,,action
��
�
���get_sprite(sprite$,box())
�#� box(1),box(2):� box(3),box(4)
�.ș "OS_SpriteOp",256+14,spritearea,sprite$
��
�
���grabbox(box(),sprite$)
�.� grabs the screen area defined by box and
�)� saves it as a sprite called sprite$
��get_sprite(sprite$,box())
�
��restorebox(box(),sprite$)
8� restores screen area defined by box and previously
*� saved by PROCgrabbox
4� box(1),box(2)
>�plot_sprite(sprite$,0)
H�delay(20):*FX15
R�
\
f��graphicwindow(box())
p;� creates graphic window of the area specified by box()
z$�24,box(1);box(2);box(3);box(4);
��
�
�,� End of mouse/sprite library procedures
�,� ======================================
�
�
��dice
�� startset � startset = �:�
�I� whiteturn � �rolldice(whitethrowbox()) � �rolldice(blackthrowbox())
��
�
���rolldice(throwbox())
�*� x1,y1,x2,y2,toss,ntosses,a,d,p,count
�,�drawtextbox(dicepanel(),"",ivory,ivory)
ntosses=12:count =0
� REPEAT
� toss = 1 � ntosses
$dice1=�(6):dice2=�(6)
%
.� This is the cheating bit
/� ==== == === ======== ===
8&� IF col$="white" THEN dice2=dice1
9
Bx1 = throwbox(1)+20+�(180)
Ly1 = throwbox(2)+20+�(60)
Vx2 = x1+60+�(60)
`y2 = throwbox(2)+20+�(60)
j� x1,y1
t�plot_sprite(�dice1,0)
~� x2,y2
��plot_sprite(�dice2,0)
�count+=1
�� count=2 �
�count=0
�a=1:p=120+�(30):d=5+�(5)
�� 2,-a,p,d: �delay(5)
��
�1� toss < ntosses � �clearthrowbox(throwbox())
�
� toss
��switch_update_bank
�#� x1,y1: �plot_sprite(�dice1,0)
�#� x2,y2: �plot_sprite(�dice2,0)
�switch_update_bank
� UNTIL dice1=dice2
�setdice(dice1,dice2)
�
(
2��setdice(dice1,dice2)
<#� dice1 <dice2 � Ȕ dice1,dice2
F)� dice1 = dice2 � double=� � double=�
P)dice(1)=dice1:dice(2)=dice2:dice(0)=2
Zdiceavailable = 2
d0� IF double THEN dice(3)=dice1:dice(4)=dice1
n�
x
�&��rollstartdice(col$,dice1,� dice)
�� throwbox():� throwbox(4)
�L� col$="white" � throwbox()=whitethrowbox() � throwbox()=blackthrowbox()
�ntosses=8:count =0
�� toss = 1 � ntosses
�
dice=�(6)
�2� (col$="black" � dice=dice1 � toss=ntosses) �
��:dice=�(6):� dice<>dice1
��
�x1 = throwbox(1)+20+�(200)
�y1 = throwbox(2)+20+�(60)
�x2 = x1+60+�(80)
�y2 = throwbox(2)+20+�(60)
� x1,y1
�plot_sprite(�dice,0)
count+=1
"� count=2 �
,count=0
6a=1:p=120+�(30):d=5+�(5)
@� 2,-a,p,d: �delay(5)
J�
T1� toss < ntosses � �clearthrowbox(throwbox())
^� toss=ntosses �
h�switch_update_bank
r!� x1,y1:�plot_sprite(�dice,0)
|�switch_update_bank
��
�
� toss
��
�
���delay(t)
��=0:� � � > t
��
�
���clearthrowbox(throwbox())
�Z� green: ȓ Ȑ throwbox(1),throwbox(2),throwbox(3)-throwbox(1),throwbox(4)-throwbox(2)
��
�
���shadow_panel
� screen
� screen = 1 � 2
�switch_update_bank
&
�panel
0�switch_display_bank
:� screen
D�
N
X��panel
b
� midgrey
l0ȓ Ȑ boardsize+8,0,1240-boardsize,boardsize
v� 128+midgrey
�� white
�� �66,1);"W H I T E"
�"� �66,3) �centre(whiteplayer$)
�� �69,4);"�";whitemoney
�� �66,5);"Game score "
�� �70,6);whitegamescore
�� black
�� �66,10)"B L A C K"
�#� �66,12) �centre(blackplayer$)
�� �69,13) "�";blackmoney
�� �66,14);"Game score "
�� �70,15);blackgamescore
��movepanel
�drawpanels
�dicepanel
�
*ݤcentre(S$)
4� L%
>
L%=�S$
H$� L% <10 � S$=�(10-L%)�2," ")+S$
R=S$
\
f��dicepanel
p� dice,roll,xoff,i,n,s
z� double �
�xoff = 8:n=4
�� firstpair �
�+showdice(1)=dice(1):showdice(2)=dice(2)
�8showdice(3)=dice(1) � 128: showdice(4)=dice(2) � 128
��
�3showdice(1)=dice(1)+128:showdice(2)=dice(2)+128
�+showdice(3)=dice(1):showdice(4)=dice(2)
��
��
�+showdice(1)=dice(1):showdice(2)=dice(2)
�xoff = 40:n=2
��
�� 5
� dicerolled �
� dice = 1 � n
roll = showdice(dice)
$(� roll > 128 � � lightgrey � � black
./� dicepanel(1)+xoff+30*dice,dicepanel(2)+48
8�; roll � 128
B
� dice
L�
V,�drawtextbox(dicepanel(),"",ivory,ivory)
`�
j�4
t-� gameinprogress �shadow_box(dicepanel())
~�
�
���movepanel
�� text$
�� gameinprogress �
�9� whiteturn � text$="White Move" � text$="Black Move"
��
�text$="New Game"
��
�.�drawtextbox(movepanel(),text$,ivory,blue)
�/� gameinprogress � �shadow_box(movepanel())
��
�
��drawpanels
� panno,textcol,s
M� gameinprogress � paneltext$(4)="QUIT GAME" � paneltext$(4)="START GAME"
� panno = 1 � 4
(>� panelactive(panno) � textcol = red � textcol = lightgrey
2�panelcoords(panno,panel())
<9�drawtextbox(panel(),paneltext$(panno),white,textcol)
F� panno
P.� gameinprogress � �shadow_box(panelbox())
Z�
d
n��draw_double_panel
x
� s,d:d=2
�� s = 1 � 2
��switch_update_bank
��panelcoords(d,panel())
�7�drawtextbox(panel(),paneltext$(d),white,lightgrey)
��switch_display_bank
�� s
��
�
� ��panelcoords(panno,panel())
�� i
�� i = 1 � 4
�panel(i) = panels(i,panno)
�� i
�
��startgame
"� panno,x,y,button
,�
6panno = �getpanel
@� panno = 3 � �setoptions
J� panno = 4
T�choosestart
^+� whiteplayer$="HUMAN" � whiteopening=�
h+� blackplayer$="HUMAN" � blackopening=�
rgameinprogress=�
|�
�
���choosestart
� � dicew,diceb,message$,box()
�J� box(4):box()=cantbox():box(2)-=270:box(4)-=270:box(1)-=60:box(3)-=60
�#�rollstartdice("white",0,dice1)
�'�rollstartdice("black",dice1,dice2)
�whiteturn = (dice1>dice2)
�C� whiteturn � message$="WHITE STARTS" � message$="BLACK STARTS"
��grabbox(box(),"temp")
��displaybox(box(),message$)
��restorebox(box(),"temp")
�$�setdice(dice1,dice2):startset=�
��
ݤgetpanel
6� checks mouse presses in panel and returns number
&$� if active panel clicked else 0
09� panno, button,x,y, found,last: panno = 0: found = �
:&� gameinprogress � last=5 � last=4
D�
N
panno +=1
X� panno=5 �
bpanel()=gamebox()
l�
v�panelcoords(panno,panel())
��
�#� �mouseinbox(panel(),button) �
�3� panelactive(panno) � panno=5 � found = � � �7
��
�� found � panno = last
�� panno=5 � panno=1
�� found � = panno � = 0
�
���setoptions
�� moneyreset,ok
�moneyreset=�
��grabbox(optbox(),"temp")
��optionsbox
ok=�
�
panel()=optpanel()
button=0
*� i = 1 � 4
4%� i>1 � panel(2)-=76:panel(4)-=76
>"� �mouseinbox(panel(),button)�
H
Ȏ i �
RS� 1: � whiteplayer$="COMPUTER" � whiteplayer$="HUMAN" � whiteplayer$="COMPUTER"
\0�drawtextbox(panel(),whiteplayer$,white,red)
fS� 2: � blackplayer$="COMPUTER" � blackplayer$="HUMAN" � blackplayer$="COMPUTER"
p0�drawtextbox(panel(),blackplayer$,white,red)
z&� 3: blackmoney=100:whitemoney=100
��� moneyreset � moneyreset=�:�drawtextbox(panel(),"RESET",white,red) � moneyreset=�:�drawtextbox(panel(),"RESET",white,lightgrey)
�E� 4: � evaldisplay$="ON" � evaldisplay$="OFF" � evaldisplay$="ON"
�0�drawtextbox(panel(),evaldisplay$,white,red)
��
��
�Eȗ ȓ optbox(1),optbox(2),optbox(3)-optbox(1),optbox(4)-optbox(2)
�� i
�V� �mouseinbox(quitpanel(),button) � sure=�surebox(""):� sure � �12:�("FX 200,0"):�
�*� �mouseinbox(okpanel(),button) � ok=�
�� ok
�button=0:*FX15
��
�ȗ x,y,button
� button
ȗ ȓ 0,0,1239,1203
�4
$ �restorebox(optbox(),"temp")
.�shadow_panel
8�
B
L��optionsbox
V� i,x,y,border:border=32
`�5
j"�showbox(optbox(),black,ivory)
tx=optbox(1)+2*border
~� black
�� i = 1 � 4
�y=optbox(4)-i*76
�� x,y:� opttext$(i)
�� i
�7�drawtextbox(quitpanel(),"QUIT PROGRAM",white,blue)
�0�drawtextbox(okpanel(),"OK",lightgrey,black)
�panel()=optpanel()
�� i = 1 � 4
�%� i>1 � panel(2)-=76:panel(4)-=76
�
Ȏ i �
�� 1: text$=whiteplayer$
�� 2: text$=blackplayer$
� 3: text$="RESET"
� 4: text$=evaldisplay$
�
)�drawtextbox(panel(),text$,white,red)
(� i
2�
<
F
P
��play
Z� x,y,button,screen
d*FX200,0
n� �
xI� � � gameinprogress=�:ȗ �:ȗ ȓ 0,0,1239,1023:�4,26:�("FX 200,1"):�
�>� whiteplayer$="COMPUTER" � blackplayer$="COMPUTER" � ȗ �
�ȕ gameinprogress
�� whiteturn �
�K� whiteplayer$ = "HUMAN" � �humanplay("white") � �computerplay("white")
�whiteturn = �
��
�K� blackplayer$ = "HUMAN" � �humanplay("black") � �computerplay("black")
�whiteturn = �
��
�� screen = 1 � 2
�C�clearthrowbox(whitethrowbox()):�clearthrowbox(blackthrowbox())
��switch_update_bank
�� screen
�showscore
N� gameinprogress � � (whiteplayer$="COMPUTER" � blackplayer$="COMPUTER") �
d� IF (whiteturn AND whiteplayer$="COMPUTER") OR (NOT whiteturn AND blackplayer$="COMPUTER") THEN
"� button=0:*FX15
,*� REPEAT:MOUSE x,y,button:UNTIL button
6� ENDIF
@�
JJ� allpast � � allpast_weight � �allpast_weightings: allpast_weight = �
T�
^ȗ �
h*FX200,0
r�
|
�
ݤallpast
�A� returns TRUE when pieces of each colour are past each other
� � and no hitting is possible
�3� point,present,allpast,found,maxblack,minwhite
�� barwhite � barblack � =�
�point=0:found=�
�ȕ � found
�point+=1
�@� board?point < 128 � board?point>0 � minwhite=point:found=�
��
�point=25:found=�
�ȕ � found
�point-=1
0� board?point > 128 � maxblack=point:found=�
�
allpast=(minwhite>maxblack)
&=allpast
0
:��showscore
D� text$,x,y,button,screen
N� evaldisplay$="ON" �
X-� whiteturn � col$="black" � col$="white"
b^current_score=�evaluateboard(col$,board,whitepieces,blackpieces,barwhite,barblack,winner$)
l!text$=col$+" "+�current_score
v� screen = 1 � 2
�/�drawtextbox(dicepanel(),text$,ivory,black)
��switch_update_bank
�� screen
��
��
��
�
�
���computerplay(col$)
�� move,moveover,p,s
�
Ȏ col$ �
�� "white":whitebearing=�
�� "black":blackbearing=�
�
� SYS "Hourglass_On"
� p = 1 � 4
panelactive(p)=�
*� p
4�movepanel:�drawpanels
>moveover=�
H1�computer_offer(col$): � � gameinprogress � �
Rȗ �
\.�dice: dicerolled=�:firstpair=�:�dicepanel
f5� �opening_move(col$) � �find_opening_moves(col$)
p*� double � firstpair=�:diceavailable=2
z�
�!� �legalmoveavailable(col$) �
�$� � allpast � allpast = �allpast
�$move = �choosecomputermove(col$)
�#startpoint = legalmoves(1,move)
�!endpoint = legalmoves(2,move)
�!diceused = legalmoves(3,move)
� barmove = legalmoves(4,move)
� bearing = legalmoves(5,move)
�dice(diceused) +=128
�diceavailable -= 1
�-�computerdrag(col$,startpoint,endpoint,�)
�*�executemove(col$,startpoint,endpoint)
��dicepanel
�
ȗ �:�cantmove(col$,"")
moveover=�
$�
.� diceavailable=0 �
8� double �
B� firstpair �
L9diceavailable=2:firstpair=�:dice(1)-=128:dice(2)-=128
V�
`moveover=�
j�
t�
~moveover=�
��
��
�!� � gameinprogress � moveover
�dicerolled=�:�dicepanel
�� �opening_move(col$) �
�4� col$="white" � whiteopening=� � blackopening=�
��
�5� REPEAT UNTIL GET:REM **************************
��
�
�ݤopening_move(col$)
�
Ȏ col$ �
� "white": = whiteopening
� "black": = blackopening
�
(��humanplay(col$)
2ȗ �
<4�x,y,button,startpoint,endpoint,legal,moveover,s
F
Ȏ col$ �
P� "white":whitebearing=�
Z� "black":blackbearing=�
d�
n� SYS "Hourglass_On"
xmoveover=�
�,� pressed, panno: pressed = �: panno = 0
�panelactive(1) = �
�E� doubleturn$ ="either" � doubleturn$ = col$ � panelactive(2) = �
�panelactive(3) = �
�panelactive(4) = �
��movepanel:�drawpanels
�%� look for mouse presses in panel
�� SYS "Hourglass_Off"
�� � startset �
��
�panno = �getpanel
�$� panno = 2 � �offerdouble(col$)
�� panno = 4 �
5� �surebox("") � gameinprogress=�:gamecompleted=�
ȗ ȓ 0,0,1239,1023
�
""� � gameinprogress � panno = 1
,�
6� � gameinprogress � �
@Bpanelactive(1)=�:panelactive(2)=�:panelactive(4)=�:�drawpanels
J.� game may be over due to refused offer so
T� gameinprogress �
^-�dice:dicerolled=�:firstpair=�:�dicepanel
h*� double � firstpair=�:diceavailable=2
r�
|!� �legalmoveavailable(col$) �
�$� � allpast � allpast = �allpast
��
�startpoint=0:endpoint=0
� *FX15
�ȗ x,y,button
�)� button � startpoint = �pointxy(x,y)
�$� �legalstart(startpoint,col$) �
�endpoint =�drag(col$,x,y)
�/legal= �legalmove(col$,startpoint,endpoint)
��
�legal=�
��
�� legal
*�executemove(col$,startpoint,endpoint)
�dicepanel
�
&�cantmove(col$,"")
0moveover=�
:�
D� diceavailable=0 �
N� double �
X� firstpair �
b9diceavailable=2:firstpair=�:dice(1)-=128:dice(2)-=128
l�
vmoveover=�
��
��
�moveover=�
��
��
�!� � gameinprogress � moveover
��
�dicerolled=�:�dicepanel
��
�
�ݤshowcol(col$)
�(� col$="white" � ="WHITE" � ="BLACK"
�
!��offerdouble(col$)
!+� oppcol$,offset,tempbox():� tempbox(4)
!!tempbox()=surebox():offset=60
! Isurebox(2)-=240:surebox(4)-=240:surebox(1)-=offset:surebox(3)-=offset
!*6� col$="white" � oppcol$="black" � oppcol$="white"
!4!� �surebox("OFFER DOUBLE?") �
!>� �computercol(oppcol$) �
!H%doubled=�double_accepted(oppcol$)
!R�
!\(doubled = �surebox("ACCEPT DOUBLE?")
!f�
!p� doubled �
!z�accept_double(oppcol$)
!��
!�double_refused=�
!��winner(col$)
!��
!��
!�surebox()=tempbox()
!��
!�
!���computer_offer(col$)
!�ȗ �
!�5� � (doubleturn$=col$ � doubleturn$="either") � �
!�+� oppcol$,offset,tempbox():� tempbox(4)
!�!tempbox()=surebox():offset=60
"Isurebox(2)-=240:surebox(4)-=240:surebox(1)-=offset:surebox(3)-=offset
"6� col$="white" � oppcol$="black" � oppcol$="white"
",� current_score < 8 - double_threshold �
"$� offer double
".� �computercol(oppcol$) �
"82�cantmove(col$," "+�showcol(col$)+" DOUBLES")
"B'doubled = �double_accepted(oppcol$)
"L�
"V(doubled = �surebox("ACCEPT DOUBLE?")
"`�
"j� doubled �
"t�accept_double(oppcol$)
"~�
"�double_refused=�
"��winner(col$)
"��
"��
"�surebox()=tempbox()
"��
"�
"�ݤcomputercol(col$)
"�X=(col$="white" � whiteplayer$="COMPUTER") � (col$="black" � blackplayer$="COMPUTER")
"�
"�ݤdouble_accepted(col$)
"�#� threshold,ownpieces,opppieces
# x� col$="white" � ownpieces = whitepieces: opppieces = blackpieces � ownpieces = blackpieces: opppieces = whitepieces
#
$threshold = -double_threshold -8
#� allpast � threshold = -16
#$� opppieces < 10 � threshold = 0
#(!� current_score < threshold �
#2double_refused=�
#<2�cantmove(col$," "+�showcol(col$)+" REFUSES")
#F=�
#P�
#Z=�
#d�
#n
#x��accept_double(col$)
#�ș "Hourglass_On"
#�B� doublecube = 64 � doublecube = 2 � doublecube = 2*doublecube
#�@� doublecube = 64 � doubleturn$="neither" � doubleturn$=col$
#�panelactive(2)=�:doubled=�
#�I� �computercol(col$) � �cantmove(col$," "+�showcol(col$)+" ACCEPTS")
#��shadow_drawbar
#��draw_double_panel
#�ș "Hourglass_Off"
#��
#�
#�ݤlegalstart(point,col$)
#�� legal,bar
#�� point = 0 � = �
$� check for pieces on bar
$� �piecesonbar(col$) �
$� point = 99 � =� � = �
$"�
$,N� Otherwise point is "legal" if pieces of correct colour are present on it
$6legal=�
$@
Ȏ col$ �
$J;� "white": � board?point >0 � board?point<128 � legal=�
$T-� "black": � board?point >128 � legal = �
$^�
$h
=legal
$r
$|ݤpiecesonbar(col$)
$�� bar:bar=�
$�
Ȏ col$ �
$�� "white":
$�� barwhite >0 �
$� bar=�
$��
$�� "black":
$�� barblack >0 �
$� bar=�
$��
$��
$�=bar
$�
%
%ݤpointxy(x,y)
%?� returns point number corresponding to screen co-ordinates
%&&� or 99 for click on bar or else 0
%04� barleft,topboard,bottomboard,point,xp,yp,found
%:$barleft = (boardsize-barwidth)/2
%D.� x > barleft � x < barleft+barwidth � =99
%NX� y > boardsize-bordersize-pointheight � x < boardsize � topboard = � � topboard = �
%XP� y < bordersize+pointheight � x < boardsize � bottomboard = � � bottom = �
%b%� � (topboard � bottomboard) � =0
%l
found = �
%v'� topboard � point = 0 � point = 12
%�ȕ � found � point <24
%�point+=1
%��startpoint(point,xp,yp)
%�+� x> xp � x < xp+pointwidth � found = �
%��
%�E� (topboard � point>12) � (bottomboard � point>24) � =0 � = point
%�
%�ݤdrag(col$,startx,starty)
%�6� allows player to drag circle from starting point
%�>� returns point number of position where mouse is released
%� � x,y,button,r:r=piecesize/2
%� � 3,1
%�ȗ x,y,button
&!� button � ȏ startx,starty,r
&
ȕ button
&
ȗ � 2
& *FX15
&*ȗ x,y,button
&4ȏ startx,starty,r
&>� button �
&Hȏ x,y,r
&Rstartx=x:starty=y
&\�
&f�
&p
ȗ � 1
&z8� startx>boardsize � =111 � =�pointxy(startx,starty)
&�#� 111 code for bearing off move
&�
&�4��computerdrag(col$,startpoint,endpoint,hitmove)
&��� startx,starty,endx,endy,npstart,npend,offset,xstep,ystep,x,y,steps,step,r,oldx1,oldy1,oldx2,oldy2,box(),oppcol$,sprite$,oldsprite1$,oldsprite2$,k,i
&�� 24,0;0;1024;1023;
&�k=20
&�6� col$="white" � oppcol$="black" � oppcol$="white"
&�� box(4)
&�&� PROCget_sprite("temp",gamebox())
&�r=piecesize/2
&�� startpoint = 99 �
&�<� col$="white" � npstart = barwhite � npstart = barblack
&��
'$npstart = board?startpoint � 128
'�
'� hitmove �
'$8� col$="white" � npend = barwhite � npend = barblack
'.�
'8 npend = board?endpoint � 128
'B�
'L� npstart>6 � npstart=6
'V� npend <6 � npend +=1
'`� npend>6 � npend=6
'jC� npend = 2 � �pointstate(endpoint) = ("one"+oppcol$) � npend=1
't:�findpiecepoint(col$,npstart,startpoint,startx,starty)
'~2�findpiecepoint(col$,npend,endpoint,endx,endy)
'�8steps = �(36*�distance(startx,starty,endx,endy)/480)
'�xstep=(endx-startx)/steps
'�ystep=(endy-starty)/steps
'�� � hitmove �
'�� startpoint <99 �
'�'board?startpoint=board?startpoint-1
'�/� board?startpoint=128 � board?startpoint=0
'��
'�
Ȏ col$ �
'�� "white": barwhite -=1
'�� "black": barblack -=1
'��
( �
(
�
(� GCOL 3,1
(� CIRCLE startx,starty,r
((startx-=r:starty-=r
(2
*FX 112,1
(<
*FX 113,1
(F update_bank=1:display_bank=1
(P� startpoint = 99 �
(Z�shadow_drawbar
(d�
(n#�shadow_drawpoint(startpoint,�)
(x�
(�&�grabarea("temp1",startx,starty,k)
(�� startx,starty
(�� � hitmove �
(��plot_sprite(col$,8)
(�3� i = 1 � 8:�switch_display_bank:�delay(10):� i
(��
(�oldx1=startx:oldy1=starty
(��switch_update_bank
(�&�grabarea("temp2",startx,starty,k)
(�� startx,starty
(�&� � hitmove � �plot_sprite(col$,8)
(�oldx2=startx:oldy2=starty
(��switch_update_bank
)+oldsprite1$="temp1":oldsprite2$="temp2"
)�switch_display_bank
)�
)"� step = 1 � steps + 1
),� update_bank=1 �
)6sprite$=oldsprite1$
)@� oldx1-k,oldy1-k
)J�
)Tsprite$=oldsprite2$
)^� oldx2-k,oldy2-k
)h�
)r�plot_sprite(sprite$,0)
)|� step < steps + 1 �
)�startx+=xstep:starty+=ystep
)��
)�� update_bank = 1 �
)� oldx1=startx: oldy1 = starty
)��
)� oldx2=startx: oldy2 = starty
)��
)�sprite$=�update_sprite
)�&�grabarea(sprite$,startx,starty,k)
)�A� update_bank = 1 � oldsprite1$=sprite$ � oldsprite2$=sprite$
)�� startx,starty
)��plot_sprite(col$,8)
)��switch_display_bank
*�switch_update_bank
*� PROCdelay(1)
*
� step
*&�switch_display_bank
*0�
*:� 26
*D�
*N
*Xݤdistance(x1,y1,x2,y2)
*b=�((x1-x2)^2+(y1-y2)^2)
*l
*v��grabarea(sprite$,x,y,k)
*�0� x-k,y-k:� x+piecesize+k,starty+piecesize+k
*�.ș "OS_SpriteOp",256+14,spritearea,sprite$
*��
*�
*�
*�ݤupdate_sprite
*�="temp"+�update_bank
*�
*�.��findpiecepoint(col$,piece,point,� x,� y)
*�� offset
*�� point = 111 �
*�x = boardsize + 64
*�y = boardsize/2
+�
+�
+� point = 99 �
+ "offset = (piece-0.5)*piecesize
+*
Ȏ col$ �
+4� "white":
+>�startpoint(7,x,y)
+Hy =ytop-offset
+R
� "black"
+\�startpoint(18,x,y)
+fy = ybottom + offset
+p�
+zx+=pointwidth+barwidth/2
+��
+��startpoint(point,x,y)
+�x+= pointwidth/2
+�#offset = (piece-0.50)*piecesize
+�6� point < 13 � y = ytop-offset � y =ybottom+offset
+��
+��
+�
+�ݤlegalmoveavailable(col$)
+�<� Called at start of move to check that move can be made
+�B� also creates list of legal moves for use by computer version
+�'� dice,roll,from,to,using,dest,code
+�nlegal=0: bearingpossible=�
,:� �opening_move(col$) � � �set_opening_move(col$) � =�
,� check barmove
,4� �piecesonbar(col$) � barmove = � � barmove = �
,$� barmove �
,.� dice = 1 � dice(0)
,8roll=dice(dice)
,B� roll < 128 �
,LA� �destinationOK(99,roll,col$,dest) � �addlegal(99,dest,dice)
,V�
,`
� dice
,j�
,t� from = 1 � 24
,~code = board?from
,�F� (col$="white" � code>0 � code<128) � (col$="black" � code>128) �
,�� dice = 1 � dice(0)
,�roll=dice(dice)
,�� roll < 128 �
,�E� �destinationOK(from,roll,col$,dest) � �addlegal(from,dest,dice)
,��
,�
� dice
,��
,�
� from
,��
,�� PRINT TAB(0,0);nlegal
,�=nlegal
-
-
ݤset_opening_move(col$)
-;� returns TRUE if destination point clear of opposition
-4� so that computer can usually make set moves if
-(� the second to move
-2� ok,oppcol$,from,to
-<ok=�
-F6� col$="white" � oppcol$="black" � oppcol$="white"
-P%bearing=�:barmove=�:movefrombar=�
-Z"dice = dice(0)+1-diceavailable
-d@� diceavailable=2 � ok=�project_opening_move(col$,2,from,to)
-n� � ok � =�notok(col$)
-x/ok=�project_opening_move(col$,dice,from,to)
-�� � ok � =�notok(col$)
-��addlegal(from,to,dice)
-�=�
-�
-�ݤnotok(col$)
-�
Ȏ col$ �
-�� "white":whiteopening=�
-�� "black":blackopening=�
-��
-�nlegal=0
-�0� PRINT TAB(0,0);col$;" ";diceavailable,dice
-�=�
-�
.1ݤproject_opening_move(col$,dice,� from,� to)
.� ok,oppcol$,d
..� double � � firstpair � d=dice+2 � d=dice
."from = openings(d)
.,<� col$="white" � to=from+dice(dice) � to=from-dice(dice)
.66� col$="white" � oppcol$="black" � oppcol$="white"
.@4� �pointpieces(oppcol$,to,board)=0 � ok=� � ok=�
.J=ok
.T
.^��cantmove(col$,message$)
.h�7
.r�grabbox(cantbox(),"temp")
.|�cantbox(col$,message$)
.�!�restorebox(cantbox(),"temp")
.�dicerolled=�:�dicepanel
.��
.�
.�
.���addlegal(from,to,using)
.�
nlegal+=1
.�legalmoves(1,nlegal) = from
.�X� bearing � bearingpossible=�:legalmoves(2,nlegal) = 111 � legalmoves(2,nlegal) = to
.� legalmoves(3,nlegal) = using
.�"legalmoves(4,nlegal) = barmove
.�"legalmoves(5,nlegal) = bearing
.��
/
/0ݤdestinationOK(startpoint,roll,col$,� dest)
/#� state$,diff,legal,d,dicefound
/&legal=�
/0� check for moving off bar
/:� startpoint = 99 �
/Dmovefrombar=�
/N
Ȏ col$ �
/X� "white": startpoint=0
/b� "black": startpoint=25
/l�
/v�
/�movefrombar=�
/��
/�$� check for destination on board
/�C� col$ ="white" � dest = startpoint+roll � dest=startpoint-roll
/�� dest <1 � dest > 24 �
/�$� PRINT TAB(0,0);startpoint,dest
/�1bearing = �bearingcheck(startpoint,dest,col$)
/�� bearing � = � � = �
/��
/�
bearing=�
/��
/�$� check for state of destination
/�state$ = �pointstate(dest)
0O� (state$="onewhite" � col$="black") � (state$="oneblack" � col$="white") �
0barmove=�:=�
0�
0
barmove=�
0*�
04;� state$ ="empty" � state$=col$ � �state$,5)=col$ � = �
0>=�
0H
0R#ݤbearingcheck(start,dest,col$)
0\&� possible,point,maxpoint,minpoint
0f=� (col$="white" � dest<0) � (col$="black" � dest>24) � =�
0p#� � �bearingpossible(col$) � =�
0zpossible=�
0�
Ȏ col$ �
0�� "black":
0�� dest=0 �
0�possible =�: � exact number
0��
0�maxpoint=0
0�� point=1 � 6
0�7� board?point>128 � point>maxpoint � maxpoint=point
0�� point
0�8� maxpoint <�mindice � maxpoint = start � possible=�
0��
0�� "white":
0�� dest=25 �
1possible=�
1�
1minpoint=25
1$� point=18 � 24
1.G� board?point>0 � board?point<128 � point<minpoint � minpoint=point
18� point
1B=� (25-minpoint) <�mindice � minpoint = start � possible=�
1L�
1V�
1`
=possible
1j
1t
ݤmindice
1~/� returns number of smallest dice available
1�� dice,roll,min
1� min=6
1�� dice = 1 � dice(0)
1�roll=dice(dice)
1�� roll <128 �
1�� roll<min � min=roll
1��
1�
� dice
1�=min
1�
1�ݤbearingpossible(col$)
1�1� Checks whether all pieces within home board
2 "� point,possible: possible = �
2
Ȏ col$ �
2� "white":
2� barwhite >0 �
2(possible=�
22�
2<point=0
2F�
2Ppoint+=1
2Z2� board?point>0 � board?point<128 � possible=�
2d� point=18 � � possible
2n�
2x� "black":
2�� barblack>0 �
2�possible=�
2��
2�point=6
2��
2�point+=1
2�#� board?point>128 � possible =�
2�� point=24 � � possible
2��
2��
2�
=possible
2�
2�)ݤlegalmove(col$,startpoint,endpoint)
3#� state$,diff,legal,d,dicefound
3legal=0:dicefound=0
3�
3"legal+=1
3,G� legalmoves(1,legal)=startpoint � legalmoves(2,legal) = endpoint �
36_dicefound = legalmoves(3,legal): barmove = legalmoves(4,legal): bearing=legalmoves(5,legal)
3@�
3J � dicefound � legal = nlegal
3T� dicefound �
3^dice(dicefound) +=128
3hdiceavailable -= 1
3r�
3|= dicefound
3�
3�ݤpointstate(point)
3�%� board?point � 128 =0 � ="empty"
3�"� board?point =1 � ="onewhite"
3�$� board?point =129 � ="oneblack"
3� � board?point>128 � ="black"
3�="white"
3�
3�!��executemove(col$,start,end)
3�� screen,oppcol$
3�6� col$="white" � oppcol$="black" � oppcol$="white"
3�+� bearing � �bearoffpiece(col$,start):�
3�*� movefrombar � � �computercol(col$) �
4
Ȏ col$ �
4� "white": barwhite -=1
4� "black": barblack -=1
4&�
40�shadow_drawbar
4:�
4D� � �computercol(col$) �
4Nboard?start=board?start-1
4X%� board?start=128 � board?start=0
4b�
4l�
4v� � barmove �
4�0� col$="black" � board?end=0 � board?end=128
4�board?end=board?end+1
4��
4�board?end=1
4�%� col$="black" � board?end += 128
4��
4�� screen = 1 � 2
4��switch_update_bank
4��drawpoint(start)
4��drawpoint(end)
4��switch_display_bank
4�� screen
4�� barmove �
5� 1,-10,70,5
5#�computerdrag(oppcol$,end,99,�)
5
Ȏ col$ �
5 '� "white": barblack+=1: board?end=1
5*)� "black": barwhite+=1: board?end=129
54�
5>�shadow_drawbar
5H�
5R2� IF movefrombar THEN PROCshadow_box(barbox())
5\�
5f
5p��cantbox(col$,message$)
5z� message$="" �
5�9� col$="white" � message$ ="WHITE" � message$="BLACK"
5�message$+=" CANNOT MOVE"
5��
5�ș "Hourglass_Smash"
5�#�displaybox(cantbox(),message$)
5��
5�
5�$��displaybox(cantbox(),message$)
5�� x,y,button,xm,ym
5�#�showbox(cantbox(),black,ivory)
5�button=0:*FX15
5�xm = cantbox(1)+128
5�ym = cantbox(2)+240
6
� blue
6� 5
6� xm,ym: � message$
6$ � red
6.8� cantbox(1)+128,cantbox(2)+100:� "Press any button"
68�
6Bȗ x,y,button
6L� button
6V� 4
6`ȗ ȓ 0,0,1239,1023
6j�
6t
6~%��showbox(box(),bordercol,boxcol)
6�� border:border=32
6�� bordercol
6�3ȓ Ȑ box(1),box(2),box(3)-box(1),box(4)-box(2)
6�� boxcol
6�Sȓ Ȑ box(1)+border,box(2)+border,box(3)-box(1)-2*border,box(4)-box(2)-2*border
6�3ȗ ȓ box(1),box(2),box(3)-box(1),box(4)-box(2)
6��
6�
6���windisplay(m1$,m2$,m3$)
6�(� border,x,y,ystep,centresize,button
6�1border=32:centresize=(optbox(3)-optbox(1))�16
6��grabbox(optbox(),"temp")
7 "�showbox(optbox(),black,white)
7
�5
7ystep=3*border
7$x=optbox(1): y = optbox(4)-ystep
7(� black
72$� x,y:� �centrel(m1$,centresize)
7<y-=ystep: � red
7F$� x,y:� �centrel(m2$,centresize)
7Py-=ystep:� blue
7Z$� x,y:� �centrel(m3$,centresize)
7dy-=ystep: � black
7n3� x,y:� �centrel("Press any button",centresize)
7x�4
7� *FX15
7��:ȗx,y,button:� button
7� �restorebox(optbox(),"temp")
7�ȗ ȓ 0,0,1239,1023
7��
7�
7�ݤcentrel(text$,space)
7�5� adds blanks to left of text$ to centre in space
7� � l,a
7�l=�(text$):a=(space-l) � 2
7�=�a," ")+text$
7�
7�ݤsurebox(message$)
86� yespanel(),nopanel(),border,button,sure,decision
8
border=32
8� yespanel(4),nopanel(4)
8"oyespanel(1)=surebox(1)+70:yespanel(2)=surebox(2)+100:yespanel(3)=yespanel(1)+100:yespanel(4)=yespanel(2)+80
8,8nopanel()=yespanel():nopanel(1)+=130:nopanel(3)+=130
86�grabbox(surebox(),"temp2")
8@%�showbox(surebox(),midgrey,white)
8J,�drawtextbox(yespanel(),"YES",ivory,red)
8T*�drawtextbox(nopanel(),"NO",ivory,red)
8^
� blue:�7
8h�5
8r,� message$="" � message$="ARE YOU SURE?"
8|,� surebox(1)+80,surebox(4)-80:� message$
8�button=0:decision=�
8��
8�8� �mouseinbox(yespanel(),button) � sure=�:decision=�
8�7� �mouseinbox(nopanel(),button) � sure=�:decision=�
8�� decision
8�"�restorebox(surebox(),"temp2")
8��4:ȗ ȓ 0,0,1239,1023
8� =sure
8�
8�
8���bearoffpiece(col$,start)
8�� winner$,s: winner$=""
8�
Ȏ col$ �
9� "white":
9� white
9whitebearing=�
9&whitegamescore +=1
90whitepieces -=1
9:%� whitepieces = 0 � winner$ =col$
9D� s = 1 � 2
9N� �70,6);whitegamescore
9X�switch_update_bank
9b� s
9l� "black":
9v� black
9�blackbearing=�
9�blackgamescore +=1
9�blackpieces -=1
9�&� blackpieces = 0 � winner$ = col$
9�� s = 1 � 2
9�� �70,15);blackgamescore
9��switch_update_bank
9�� s
9��
9�� � �computercol(col$) �
9�board?start=board?start-1
9�%� board?start=128 � board?start=0
9��shadow_drawpoint(start,�)
:�
::� When computer is bearing off, start point is redrawn
:� by PROCcomputerdrag
: $� winner$ >"" � �winner(winner$)
:*�
:4
:>��winner(col$)
:HA� message1$,message2$,message3$,winnings,bonus,winner$,loser$
:RS� doublecube = 64 � doubleturn$="either" � winnings = 1 � winnings = doublecube
:\bonus=�winbonus(col$,board)
:fwinnings = winnings*bonus
:pT� col$="white" � winner$="WHITE":loser$="BLACK" � winner$="BLACK":loser$="WHITE"
:zmessage1$=winner$+" WINS!"
:�Ȏ bonus �
:�$� 1: message2$="STANDARD PAYOUT"
:�(� 2: message2$=loser$+" IS GAMMONED"
:�,� 3: message2$=loser$+" IS BACKGAMMONED"
:��
:�(message3$=loser$+" PAYS �"+�winnings
:�.�windisplay(message1$,message2$,message3$)
:�j� col$="white" � whitemoney+=winnings:blackmoney-=winnings � blackmoney+=winnings:whitemoney-=winnings
:�8� whitemoney < 0 � blackmoney <0 � �bankrupt(loser$)
:�gameinprogress=�
:��
:�
:���bankrupt(loser$)
;� message$
;�delay(30):*FX15
;#message$=loser$+" IS BANKRUPT!"
;$�grabbox(cantbox(),"temp")
;.#�displaybox(cantbox(),message$)
;8!�restorebox(cantbox(),"temp")
;Bȗ ȓ 0,0,1239,1023
;L!whitemoney=100:blackmoney=100
;V�
;`
;jݤwinbonus(col$,board)
;t� double_refused � =1
;~9� Returns 2 for gammon, 3 for backgammon, otherwise 1
;�� bonus,point
;�
Ȏ col$ �
;�
� "white"
;�� blackpieces < 15 �
;�bonus=1
;��
;�bonus=2
;�� point = 19 � 24
;�1� �pointpieces("black",point,board) � bonus=3
;�� point
;��
;�
� "black"
<