1 REM  GAME OF UR - GRAPHICS BY RAMIDAVIS, ENGINE BY WALID MAALOULI - DECEMBER 2017
2 CALL SCREEN(12)
3 CALL COLOR(10,5,16,11,7,1,13,2,1,14,16,1)
4 CALL CHAR(120,"FF818181818181FF")! CURSOR PATTERN
5 CALL CHAR(96,"00000000183C7EFF")! DICE PATTERN
6 CALL CHAR(104,"66E7FF2424FFE766")! STANDARD BOARD SQUARE PATTERN
7 CALL CHAR(128,"3C7EE7C3C3E77E3C",136,"3C7EE7C3C3E77E3C")! BLACK AND WHITE TOKEN PATTERNS
8 CALL CHAR(106,"0000000018000000")! TOP DICE DOT PATTERN
9 CALL CHAR(107,"0000000000000081")! BOTTOM DICE DOT PATTERN
10 CALL CHAR(112,"C381183C3C1881C3")! ROSETTE SQUARE PATTERN
11 RANDOMIZE :: OPTION BASE 0 :: DIM CP(15),PP(15),PCX(15),PCY(15),CCX(15),CCY(15)
12 FOR I=1 TO 7 :: CALL SPRITE(#I,128,2,200,1) :: NEXT I! BLACK TOKENS
13 FOR I=8 TO 14 :: CALL SPRITE(#I,136,16,208,1) :: NEXT I! WHITE TOKENS
14 CALL SPRITE(#15,32,16,169,97)! DICE
15 CALL SPRITE(#16,32,16,169,113)
16 CALL SPRITE(#17,32,16,169,129)
17 CALL SPRITE(#18,32,16,169,145)
18 CALL SPRITE(#19,120,13,200,1)! CURSOR
20 FOR I=1 TO 14 :: READ PCX(I),PCY(I) :: NEXT I
30 DATA 14,11,14,9,14,7,14,5,16,5,16,7,16,9,16,11,16,13,16,15,16,17,16,19,14,19,14,17
35 FOR I=1 TO 14 :: READ CCX(I),CCY(I) :: NEXT I
36 DATA 18,11,18,9,18,7,18,5,16,5,16,7,16,9,16,11,16,13,16,15,16,17,16,19,18,19,18,17
40 REM  DISPLAY PLAYING BOARD
50 CALL CLEAR
60 GOSUB 200
70 REM  INITIALIZE VARIABLES
80 CN=7 :: PN=7 :: CB=0 :: PB=0 :: RF=-1 :: RP=-1 :: CSN=7 :: PSN=7 :: CW=0 :: PW=0
90 FOR I=0 TO 14 :: CP(I)=0 :: PP(I)=0 :: NEXT I
100 REM  DETERMINE WHO GOES FIRST
101 GOSUB 300 :: R1=ROLL :: GOSUB 300 :: R2=ROLL
102 IF R1>R2 THEN 105 ELSE IF R2>R1 THEN 110 ELSE 101
105 DISPLAY AT(24,10)BEEP :" MY TURN" :: FOR D=1 TO 300 :: NEXT D :: GOSUB 5100 :: GOTO 120
110 DISPLAY AT(24,10)BEEP :"YOUR TURN" :: FOR D=1 TO 300 :: NEXT D :: GOSUB 5700 :: GOTO 160
115 REM  CHECK FOR WIN OR START NEXT TURN
120 IF CW=0 THEN 140
130 DISPLAY AT(24,10)BEEP :" I WIN!!" :: GOTO 190
140 IF RP=-1 AND RF=-1 THEN 110 ELSE 105
160 IF PW=0 THEN 180
170 DISPLAY AT(24,10)BEEP :"YOU WIN!!" :: GOTO 190
180 IF RF=-1 THEN 105 ELSE 110
190 REM  PLAY AGAIN CHECK
191 CALL KEY(0,K,S) :: IF S=0 THEN 191
192 DISPLAY AT(24,9)BEEP :"PLAY AGAIN?"
193 CALL KEY(0,K,S) :: IF S=0 THEN 193
194 IF K<>89 THEN STOP
195 FOR I=1 TO 14 :: CALL LOCATE(#I,200,1) :: NEXT I
196 GOTO 40
200 REM  DISPLAY BOARD ROUTINE
201 RESTORE 211 :: PRINT
202 PRINT "BLACK                 WHITE N  LEFT   hhhhhhh   MEN  LEF          hph hph           "
203 PRINT "          hhhhhhh                     h h h h                     hhhhhhh           "
204 PRINT "          h h h h                     hhhhhhh                     h hph h           "
205 PRINT "          hhhhhhh                       h h                         hhh             "
206 PRINT "            h h             N HOME    hhhhhhh   MEN HOME          hph hph           "
207 PRINT "          hhhhhhh                     h h h h                     hhhhhhh           "
208 PRINT
209 PRINT "          ` ` ` `           "
210 PRINT
211 DATA 4,1,77,4,2,69,4,31,84,16,1,77,16,2,69
213 FOR FILL=1 TO 5
214 READ Y,X,CH
215 CALL VCHAR(Y,X,CH)
216 NEXT FILL
220 FOR I=2 TO 8
230 CALL HCHAR(6,I,128) :: CALL HCHAR(6,I+22,136)
240 NEXT I
250 RETURN
300 REM  DICE ROLLING ROUTINE
335 ROLL=0
340 FOR I=1 TO 4
350 X=INT(RND*4)+1
360 IF X>2 THEN X=0 ELSE X=1
370 ROLL=ROLL+X :: CALL SOUND(50,700,0)
380 NEXT I
401 IF ROLL=0 THEN 402 ELSE 406
402 FOR Y=1 TO 4
403 CALL PATTERN(#14+Y,107)
404 NEXT Y
405 GOTO 500
406 FOR Y=1 TO 4
407 CALL PATTERN(#14+Y,107)
408 NEXT Y
409 FOR Y=1 TO ROLL
410 CALL PATTERN(#14+Y,106)
411 NEXT Y
500 RETURN
600 REM  PLAYER MOVE CURSOR AND SELECT TOKEN ROUTINE
620 P=1
630 CALL LOCATE(#19,PCY(P)*8-7,PCX(P)*8-7)
640 CALL KEY(0,K,S) :: IF S=0 THEN 640
650 IF K<>78 OR PSN=0 OR PP(ROLL)=1 THEN 670
660 CALL LOCATE(#19,200,1) :: STARTSQUARE=0 :: GOTO 730
670 IF K<>68 OR P+1>14 THEN 690
680 P=P+1 :: CALL LOCATE(#19,PCY(P)*8-7,PCX(P)*8-7) :: GOTO 640
690 IF K<>83 OR P-1<1 THEN 710
700 P=P-1 :: CALL LOCATE(#19,PCY(P)*8-7,PCX(P)*8-7) :: GOTO 640
710 IF K<>13 OR PP(P)=0 OR P+ROLL>15 OR(P+ROLL=8 AND CP(8)=1)THEN 640
715 IF P+ROLL<15 AND PP(P+ROLL)=1 THEN 640
720 STARTSQUARE=P :: CALL LOCATE(#19,200,1)
730 RETURN
5100 REM  *** COMPUTER PLAY ROUTINE ***
5105 REM  CHECK FOR TOKEN EXIT
5110 GOSUB 300 :: CALL SAY(STR$(ROLL)) :: FOR D=1 TO 300 :: NEXT D :: IF ROLL>0 THEN 5115
5111 DISPLAY AT(24,10)BEEP :"  PASS!" :: CALL SAY("UHOH") :: FOR D=1 TO 300 :: NEXT D :: RF=-1 :: RP=-1 :: RETURN
5115 RP=-1 :: RF=-1
5120 IF CP(15-ROLL)=0 THEN 5180
5130 CP(15-ROLL)=CP(15-ROLL)-1 :: CB=CB-1
5135 CALL TOKENLOC(15-ROLL,2,SPRNUM,CCX(),CCY())
5136 CALL SPRMOVE(SPRNUM,CCX(15-ROLL),CCY(15-ROLL),31-CN,18)
5137 CALL HCHAR(18,31-CN,136) :: CALL LOCATE(#SPRNUM,200,1) :: CN=CN-1
5140 IF CN=0 THEN CW=1
5150 RETURN
5170 REM  CHECK FOR CAPTURE OF OPPONENT TOKEN
5180 IF CB=0 THEN 5310
5190 FOR I=1 TO 11
5200 IF CP(I)=0 THEN 5270
5210 IF I+ROLL<5 OR I+ROLL>12 THEN 5270
5215 IF I+ROLL<15 AND PP(I+ROLL)=0 THEN 5270
5220 IF I+ROLL=8 THEN 5270
5230 CALL TOKENLOC(I,2,SPRNUM,CCX(),CCY())
5231 CALL TOKENMOVE(SPRNUM,I,ROLL,CCX(),CCY())
5232 CALL TOKENLOC(I+ROLL,1,SPRNUM,PCX(),PCY())
5233 CALL SPRMOVE(SPRNUM,PCX(I+ROLL),PCY(I+ROLL),PSN+2,6)
5234 CALL HCHAR(6,PSN+2,128) :: CALL LOCATE(#SPRNUM,200,1)
5240 PB=PB-1 :: PP(I+ROLL)=0 :: PSN=PSN+1
5250 CP(I)=0 :: CP(I+ROLL)=1
5260 I=12 :: FLG=1
5270 NEXT I
5275 IF FLG=1 THEN FLG=0 :: RETURN
5310 REM  CHECK FOR ROSETTE SQUARE
5320 FOR I=1 TO 13
5330 IF CP(I)=0 THEN 5360
5340 IF I+ROLL=8 AND PP(8)=0 AND CP(8)=0 THEN RF=I
5350 IF(I+ROLL=4 OR I+ROLL=14)THEN IF CP(I+ROLL)=0 THEN RP=I
5360 NEXT I
5370 IF RF=-1 THEN 5375
5371 I=RF :: CALL TOKENLOC(I,2,SPRNUM,CCX(),CCY())
5372 CALL TOKENMOVE(SPRNUM,I,ROLL,CCX(),CCY()) :: GOTO 5390
5375 IF CB<>CN AND ROLL=4 AND CP(4)=0 THEN RP=1 :: CB=CB+1 :: I=0 ELSE 5380
5376 FOR N=8 TO 14 :: CALL POSITION(#N,Y,X) :: IF Y>199 THEN SPRNUM=N :: N=15
5377 NEXT N
5378 CALL HCHAR(6,23+CSN,32) :: CALL SPRMOVE(SPRNUM,23+CSN,6,CCX(4),CCY(4))
5379 CSN=CSN-1 :: GOTO 5390
5380 IF RP=-1 THEN 5420
5381 I=RP :: CALL TOKENLOC(I,2,SPRNUM,CCX(),CCY())
5382 CALL TOKENMOVE(SPRNUM,I,ROLL,CCX(),CCY())
5390 CP(I)=0 :: CP(I+ROLL)=1
5400 RETURN
5410 REM  MOVE TOKEN IF >2 ON BOARD
5420 IF CB<3 THEN 5550
5440 FOR I=13 TO 1 STEP-1
5450 IF I+ROLL>15 OR CP(I)=0 THEN 5520
5455 IF I+ROLL=8 AND PP(8)=1 THEN 5520
5456 IF CP(I+ROLL)=1 THEN 5520
5460 IF CP(I)=1 AND I=8 THEN RF=1 :: GOTO 5520
5480 CP(I+ROLL)=1 :: CP(I)=0
5490 CALL TOKENLOC(I,2,SPRNUM,CCX(),CCY())
5491 CALL TOKENMOVE(SPRNUM,I,ROLL,CCX(),CCY())
5510 FLG=1 :: I=0 :: RF=-1
5520 NEXT I
5525 IF FLG=1 THEN FLG=0 :: RETURN
5530 IF RF=-1 THEN 5550
5540 RF=-1 :: CP(8+ROLL)=1 :: CP(8)=0
5541 CALL TOKENLOC(8,2,SPRNUM,CCX(),CCY())
5542 CALL TOKENMOVE(SPRNUM,8,ROLL,CCX(),CCY())
5543 RETURN
5545 REM  INTRODUCE NEW TOKEN
5550 IF CN=CB OR CP(ROLL)=1 THEN 5590
5560 CP(ROLL)=1 :: CB=CB+1
5570 FOR N=8 TO 14 :: CALL POSITION(#N,Y,X) :: IF Y>199 THEN SPRNUM=N :: N=15
5571 NEXT N
5572 CALL HCHAR(6,23+CSN,32) :: CALL SPRMOVE(SPRNUM,23+CSN,6,CCX(ROLL),CCY(ROLL))
5573 CSN=CSN-1
5580 RETURN
5585 REM  MOVE TOKEN IF NO OTHER MOVE AVAILABLE
5590 FOR I=13 TO 1 STEP-1
5600 IF CP(I)=0 OR I+ROLL>15 THEN 5630
5605 IF I+ROLL=8 AND PP(8)=1 THEN 5630
5606 IF CP(I+ROLL)=1 THEN 5630
5610 CALL TOKENLOC(I,2,SPRNUM,CCX(),CCY())
5611 CALL TOKENMOVE(SPRNUM,I,ROLL,CCX(),CCY())
5620 CP(I)=0 :: CP(I+ROLL)=1
5625 FLG=1 :: I=0
5630 NEXT I
5635 IF FLG=1 THEN FLG=0 :: RETURN
5640 DISPLAY AT(24,10)BEEP :"  PASS!" :: CALL SAY("UHOH") :: FOR D=1 TO 300 :: NEXT D
5641 RF=-1 :: RP=-1 :: RETURN
5700 REM  *** PLAYER MOVE ROUTINE ***
5710 GOSUB 300 :: CALL SAY(STR$(ROLL)) :: IF ROLL>0 THEN 5720
5711 DISPLAY AT(24,10)BEEP :"  PASS!" :: CALL SAY("UHOH") :: FOR D=1 TO 300 :: NEXT D
5712 RF=-1 :: RETURN
5720 RF=-1
5740 FOR I=1 TO 14
5745 IF PP(I)=1 AND I+ROLL=8 AND CP(8)=1 THEN 5760
5746 IF PP(I)=1 AND I+ROLL<15 THEN IF PP(I+ROLL)=0 THEN FLG=1 :: I=15 :: GOTO 5760
5750 IF PP(I)=1 AND I+ROLL=15 THEN FLG=1 :: I=15
5760 NEXT I
5765 IF FLG=1 THEN FLG=0 :: GOTO 5800
5770 IF PN<>PB AND PP(ROLL)=0 THEN 5800
5780 DISPLAY AT(24,10)BEEP :"  PASS!" :: CALL SAY("UHOH") :: FOR D=1 TO 300 :: NEXT D
5781 RF=-1 :: RETURN
5800 GOSUB 600
5810 IF STARTSQUARE=0 THEN 5980
5815 IF STARTSQUARE+ROLL=15 THEN 5920
5820 IF CP(STARTSQUARE+ROLL)=0 THEN 5880
5825 IF CP(STARTSQUARE+ROLL)=1 AND(STARTSQUARE+ROLL<5 OR STARTSQUARE+ROLL>12)THEN 5880
5830 CALL TOKENLOC(STARTSQUARE,1,SPRNUM,PCX(),PCY())
5831 CALL TOKENMOVE(SPRNUM,STARTSQUARE,ROLL,PCX(),PCY())
5832 CALL TOKENLOC(STARTSQUARE+ROLL,2,SPRNUM,CCX(),CCY())
5833 CALL SPRMOVE(SPRNUM,CCX(STARTSQUARE+ROLL),CCY(STARTSQUARE+ROLL),24+CSN,6)
5834 CALL HCHAR(6,24+CSN,136) :: CSN=CSN+1 :: CALL LOCATE(#SPRNUM,200,1)
5840 CB=CB-1 :: CP(STARTSQUARE+ROLL)=0
5860 PP(STARTSQUARE)=0 :: PP(STARTSQUARE+ROLL)=1
5870 RETURN
5880 PP(STARTSQUARE)=0 :: PP(STARTSQUARE+ROLL)=1
5890 IF STARTSQUARE+ROLL=4 OR STARTSQUARE+ROLL=8 OR STARTSQUARE+ROLL=14 THEN RF=1
5900 CALL TOKENLOC(STARTSQUARE,1,SPRNUM,PCX(),PCY())
5901 CALL TOKENMOVE(SPRNUM,STARTSQUARE,ROLL,PCX(),PCY())
5910 RETURN
5920 CALL TOKENLOC(STARTSQUARE,1,SPRNUM,PCX(),PCY())
5930 CALL SPRMOVE(SPRNUM,PCX(STARTSQUARE),PCY(STARTSQUARE),9-PN,18)
5940 CALL HCHAR(18,9-PN,128) :: CALL LOCATE(#SPRNUM,200,1)
5950 PP(STARTSQUARE)=0 :: PN=PN-1 :: PB=PB-1
5960 IF PN=0 THEN PW=1
5970 RETURN
5980 FOR N=1 TO 7 :: CALL POSITION(#N,Y,X) :: IF Y>199 THEN SPRNUM=N :: N=8
5990 NEXT N
6000 CALL HCHAR(6,1+PSN,32) :: CALL SPRMOVE(SPRNUM,1+PSN,6,PCX(ROLL),PCY(ROLL))
6010 PSN=PSN-1 :: PB=PB+1 :: PP(ROLL)=1
6020 IF ROLL=4 THEN RF=1
6030 RETURN
7000 REM  SPRITE MOTION ROUTINE
7010 SUB SPRMOVE(SPRNUM,SX,SY,TX,TY)
7015 CALL LOCATE(#SPRNUM,SY*8-7,SX*8-7)
7020 STARTX=SX*8-7 :: STARTY=SY*8-7 :: TARGETX=TX*8-7 :: TARGETY=TY*8-7 :: X=STARTX :: Y=STARTY
7030 IF TARGETY<STARTY THEN INCREMENT=-1 ELSE INCREMENT=1
7040 IF Y<>TARGETY THEN Y=Y+INCREMENT
7045 IF X=TARGETX THEN 7060
7050 IF STARTX<TARGETX THEN X=X+1 ELSE IF STARTX>TARGETX THEN X=X-1
7060 CALL LOCATE(#SPRNUM,Y,X)
7070 IF X<>TARGETX OR Y<>TARGETY THEN 7040
7080 SUBEND
7100 REM  LOCATE TOKEN SPRITE ON BOARD
7110 SUB TOKENLOC(BOARDPOS,SIDE,SPRNUM,POSARRX(),POSARRY())! SIDE=1 FOR BLACK, SIDE=2 FOR WHITE
7120 IF SIDE=2 THEN 7160
7130 FOR I=1 TO 7
7135 CALL POSITION(#I,Y,X)
7140 IF Y=POSARRY(BOARDPOS)*8-7 AND X=POSARRX(BOARDPOS)*8-7 THEN SPRNUM=I :: GOTO 7190
7150 NEXT I
7160 FOR I=8 TO 14
7165 CALL POSITION(#I,Y,X)
7170 IF Y=POSARRY(BOARDPOS)*8-7 AND X=POSARRX(BOARDPOS)*8-7 THEN SPRNUM=I :: GOTO 7190
7180 NEXT I
7190 SUBEND
7200 REM  MOVE TOKEN ON BOARD ROUTINE
7210 SUB TOKENMOVE(SPRNUM,BOARDPOS,MOVENUM,POSARRX(),POSARRY())
7220 FOR I=1 TO MOVENUM
7230 CALL LOCATE(#SPRNUM,POSARRY(BOARDPOS+I)*8-7,POSARRX(BOARDPOS+I)*8-7)
7235 CALL SOUND(50,250,0)
7240 FOR D=1 TO 100 :: NEXT D
7250 NEXT I
7260 SUBEND
