rem APP Yahtzee
rem type $1000
rem icon "M:\app\Yahtzee\Dice5.pic"
rem ENDA

PROC Main:
  GLOBAL Dice1$(128),Dice2$(128),Dice3$(128)
  GLOBAL Dice4$(128),Dice5$(128),Dice6$(128)
	GLOBAL Dice%(6),Die%(5),Cnt%,Try$(2),Sel%
  GLOBAL P1name$(10),P2name$(10),player$(10)
  GLOBAL GO%,S%,M%,P2Tot%,P1Tot%,plyr%
	GLOBAL Turn1%(16),Turn2%(16),Psion%(16)
	GLOBAL Sort%(6),Cx%,Cy%,Point%,Disk$(50)

	Intro:
	PAUSE 100 : gGREY 2 : gCLS : gGREY 0
	RANDOMIZE(SECOND)

INITIAL::
	gGREY 2 : gCLS : gGREY 0
	gUSE 1
	gVISIBLE OFF
  gAT 0,50 : gFILL 2,110,0
  gAT 0,50 : gFILL 479,2,0
  gAT 0,66 : gFILL 479,2,0
  gAT 0,158 : gFILL 479,2,0
	gAT 28,50 : gFILL 2,110,0
	gAT 82,50 : gFILL 2,110,0
	gAT 152,50 : gFILL 2,110,0
  gAT 222,50 : gFILL 4,110,0
	gAT 251,50 : gFILL 2,95,0
	gAT 338,50 : gFILL 2,110,0
	gAT 408,50 : gFILL 2,110,0
  gAT 478,50 : gFILL 2,110,0  
  gFONT  6
  gAT 6,79  : gPRINT"A1  Aces  "
  gAT 6,90  : gPRINT"A2  Twos  "
  gAT 6,101 : gPRINT"A3  Threes"
  gAT 6,112 : gPRINT"A4  Fours "
  gAT 6,123 : gPRINT"A5  Fives "
	gAT 6,134 : gPRINT"A6  Sixes "
	gAT 6,145 : gPRINT"AA  BONUS "
	gAT 4,156 : gPRINT"Sub TOTAL "
  gAT 229,79  : gPRINT"B1  3 of a kind"
  gAT 229,90  : gPRINT"B2  4 of a kind"
  gAT 229,101 : gPRINT"B3  Full House"
  gAT 229,112 : gPRINT"B4  Sml (4) Strt"
  gAT 229,123 : gPRINT"B5  Lrg (5) Strt"
	gAT 229,134 : gPRINT"B6  Yahtzee:5kd"
	gAT 229,145 : gPRINT"B7  Chance=5die"
	gAT 229,156 : gPRINT" GRAND  TOTAL"
	P0:(1,0,0,305,0) : REM the  title pic
	gVISIBLE ON

	S%=S%+1
  IF S%>1
    gCLOSE Dice%(1) : gCLOSE Dice%(2)
    gCLOSE Dice%(3) : gCLOSE Dice%(4)
    gCLOSE Dice%(5) : gCLOSE Dice%(6)
	ENDIF

  Dice1$=Disk$+"Dice1.pic"
  Dice%(1)=gLOADBIT(Dice1$,1)
  Dice2$=Disk$+"Dice2.pic"
  Dice%(2)=gLOADBIT(Dice2$,1)
  Dice3$=Disk$+"Dice3.pic"
  Dice%(3)=gLOADBIT(Dice3$,1)
  Dice4$=Disk$+"Dice4.pic"
  Dice%(4)=gLOADBIT(Dice4$,1)
  Dice5$=Disk$+"Dice5.pic"
  Dice%(5)=gLOADBIT(Dice5$,1)
  Dice6$=Disk$+"Dice6.pic"
  Dice%(6)=gLOADBIT(Dice6$,1)

	Cnt%=1
	WHILE Cnt%<=16
		Turn1%(Cnt%)=-1
		Turn2%(Cnt%)=-1
		Psion%(Cnt%)=-1
		Cnt%=Cnt%+1
	ENDWH

	If P1tot%=0 AND P2tot%=0
		Cnt% =1
		While Cnt% <=5
		Die%(Cnt%) = Cnt%
		Cnt%=Cnt%+1
		ENDWH
		Drawdie:

		PAUSE 50
		P1name$="Player 1"
	  P2name$="Player 2"
	  dINIT "   Who wants to play?"
		dTEXT "","Set one of the players to"
		dTEXT "","'PSION' to Play computer"
	  dTEXT ""," "
	  dEDIT P1name$,"Player 1"
	  dEDIT P2name$,"Player 2"
	  DIALOG
	ENDIF
  gAT 90,63  : gPRINT""+P1name$+""
  gAT 160,63 : gPRINT""+P2name$+""
  gAT 344,63 : gPRINT""+P1name$+""
	gAT 414,63 : gPRINT""+P2name$+""
	PAUSE 25
  GO%=1: plyr%=1: player$=p1name$

PLAY::
	IF Player$="PSION" OR Player$="Psion" OR Player$="psion"
		dINIT "Computer's Turn"
  ELSE
		dINIT ""+player$+"'s turn"
	ENDIF
		dTEXT "","Press ENTER to roll the dice"
		dPosition 0,-1
		Dialog
REM define dice throw
	Cnt%=1
	WHILE Cnt%<=6
		Sort%(Cnt%)=0
		Cnt%=Cnt%+1
	ENDWH
	Cnt%=1
	WHILE cnt%<=5
		Die%(cnt%)=INT(1+RND*5+0.5)
		Sort%(Die%(Cnt%))=Sort%(Die%(Cnt%))+1
		Cnt% = Cnt% + 1
	ENDWH
	Drawdie:
rem get the next selection
AGAIN::
	Try$=""
	If Player$="PSION" OR Player$="Psion" or Player$="psion"
		dINIT "Computers turn"
		dTEXT "","Please press 'RETURN' key"
		dTEXT "","for Psion to make a Play" 
		dPOSITION 1,-1
		DIALOG
		COMPUTE:
		GOTO MOVE::
	ELSE
  	dINIT ""+Player$+" "
  	dEDIT Try$, "Select category to use:"
  	dPOSITION 1,-1
  	DIALOG
  ENDIF
	Sel%=0
	IF try$="A1" or Try$="a1"
		sel%=1
	ELSEIF try$="A2" or Try$="a2"
		sel%=2
	ELSEIF try$="A3" or Try$="a3"
		sel%=3
	ELSEIF try$="A4" or Try$="a4"
		sel%=4
	ELSEIF try$="A5" or Try$="a5"
		sel%=5
	ELSEIF try$="A6" or Try$="a6"
		sel%=6
	ELSEIF try$="B1" or Try$="b1"
		sel%=7
	ELSEIF try$="B2" or Try$="b2"
		sel%=8
	ELSEIF try$="B3" or Try$="b3"
		sel%=9
	ELSEIF try$="B4" or Try$="b4"
		sel%=10
	ELSEIF try$="B5" or Try$="b5"
		sel%=11
	ELSEIF try$="B6" or Try$="b6"
		sel%=12
	ELSEIF try$="B7" or Try$="b7"
		sel%=13
	ENDIF
	IF Sel%=0
		Try$=""
		dINIT ""+player$+" "
		dTEXT "","That was not a valid code"
		dTEXT "","Press ENTER to try again"
 		dPosition 1,-1
		Dialog
  	GOTO Again::
	ENDIF

rem verify that not selected before
MOVE::
	IF Plyr%=1
		IF Turn1%(Sel%)=-1
			Score:
			Turn1%(Sel%)=Point%
		ELSE
			dINIT ""+player$+" "
			dTEXT "","You have already used that"
  		dPosition 1,-1
			Dialog
	  	GOTO Again::
		ENDIF
	ELSE
		IF Turn2%(Sel%)=-1
			Score:
			Turn2%(Sel%)=Point%
		ELSE
			dINIT ""+player$+" "
	  	dTEXT "","You have already used that"
  		dPosition 1,-1
	  	Dialog
		  GOTO Again::
		ENDIF
	ENDIF

	pause 50

  Plyr% = Plyr% + 1
  Player$ = P2name$
  IF Plyr% > 2
  	Plyr%=1
  	Player$ = P1name$
  ENDIF
	Go%=Go%+1
  IF Go%<=26
  	GOTO PLAY::
  ENDIF

rem Player1 update bonus, sub and totals
cnt%=turn1%(1)+turn1%(2)+turn1%(3)+turn1%(4)+turn1%(5)+turn1%(6)
IF cnt%>=63
	turn1%(14)=35
	gAT 110,145
	gPRINT turn1%(14)
ENDIF
turn1%(15)=cnt%+turn1%(14)
gAT 110,156
gPRINT turn1%(15)
cnt%=turn1%(7)+turn1%(8)+turn1%(9)+turn1%(10)+turn1%(11)+turn1%(12)+turn1%(13)
turn1%(16)=turn1%(15)+cnt%
gAT 364,156
gPRINT turn1%(16)

rem Player2 update bonus, sub and totals
cnt%=turn2%(1)+turn2%(2)+turn2%(3)+turn2%(4)+turn2%(5)+turn2%(6)
IF cnt%>=63
	turn2%(14)=35
	gAT 180,145
	gPRINT turn2%(14)
ENDIF
turn2%(15)=cnt%+turn2%(14)
gAT 180,156
gPRINT turn2%(15)
cnt%=turn2%(7)+turn2%(8)+turn2%(9)+turn2%(10)+turn2%(11)+turn2%(12)+turn2%(13)
turn2%(16)=turn2%(15)+cnt%
gAT 434,156
gPRINT turn2%(16)

Pause 100

IF turn1%(16) > turn2%(16)
	Player$=P1name$ : P1tot%=P1tot%+1
ELSEIF turn2%(16) > turn1%(16)
	Player$=P2name$ : P2tot%=P2tot%+1
ENDIF
If turn1%(16) <> turn2%(16)
	dINIT ""+Player$+" is the winner"
	dtext "","CONGRATULATIONS !"
	dtext "","Press 'RETURN' to continue"
ELSE
	dINIT "The game was a draw!"
  dTEXT "","Please Play another game!"
	dtext "","Press 'RETURN' to continue"
	ENDIF
  dPOSITION 1,-1
  DIALOG 

    dINIT "PLAY ANOTHER GAME"
    dTEXT "","The scores so far are"
    dTEXT "",""+P1name$+" = "+FIX$(P1tot%,0,100)+"",2
    dTEXT "",""+P2name$+" = "+FIX$(P2tot%,0,100)+"",2
    dBUTTONS "No",%N,"Yes",%Y
    M%=DIALOG
    IF M%=ASC("n")
      STOP
    ENDIF
	GOTO INITIAL::
  

ENDP
REM -----------------------------------


PROC Drawdie:
	LOCAL Countr%,Cx%,Cy%,Symbl%
	Countr%=1
	While Countr% <= 5
		symbl%=Dice%(Die%(Countr%))
		Cx%= (Countr%-1)*50+5 : Cy%=0
		gAT 0,0 : gUSE 1
		gAT CX%,CY%
		gCOPY Symbl%,0,0,50,50,3
		Countr%=countr%+1
	ENDWH
ENDP


PROC Intro:
	LOCAL text$(60)
	DEFAULTWIN 1
	gUSE 1
	gVISIBLE OFF
	P0:(0,7,0,0,0)
	P0:(0,8,1,0,0)
	P0:(0,9,1,0,146)
	P0:(0,10,0,0,14)
	P0:(0,11,1,0,14)
	P0:(0,12,0,454,14)
	P0:(0,13,1,454,14)
	gAT 0,0
	gBOX 480,160
	gAT 24,11
	gxBORDER 1,$203,431,134
	P0:(0,4,0,038,22)
	P0:(0,5,0,186,56)
	P0:(0,6,0,371,24)
	
	REM field 1: 0 = ROM, 1 = your file
	REM field 2: # of the pic in data file
	REM field 3: 0 = black, 1 = grey
	REM field 4: horiz to top left
	REM field 5: vert to top left
	REM ofset second 3 pixels horiz & vert
	REM with field3=1 for a grey shadow
	
	P0:(1,0,0,156,86) : REM your 2 title
	P0:(1,0,1,159,89) : REM pics go here
	gFONT 6
	text$="THE DICE GAME OF CHOICE      V1.00      ¸1999 Wayne Geary"
	gAT (480-gTWIDTH(text$))/2,156
	gPRINT text$
	gVISIBLE ON 
	ENDP


PROC P0:(dsk%,picno%,shade%,xposn%,yposn%) 
	LOCAL lc87%,lc88%,wid%,high%,dirtry$(128)
	Disk$=MID$(CMD$(1),1,7) : REM find disk
	         : REM where prog started from
rem 	G5$="M:" : REM normally remove this
	IF dsk%=0
		dirtry$="ROM::SYS$SHLL.IMG"
	ELSE  :REM the next line is eg only
		Disk$=Disk$+"\APP\YAHTZEE\"
		dirtry$=Disk$+"YAHTZEE.PIC"
	ENDIF
	lc87%=gIDENTITY
	lc88%=gLOADBIT(dirtry$,0,picno%)
	wid%=gWIDTH
	high%=gHEIGHT
	gUSE lc87%
	gAT xposn%,yposn%
	gGREY shade%
	gCOPY lc88%,0,0,wid%,high%,3
	gCLOSE lc88%
	gGREY 0
ENDP


PROC Compute:
LOCAL cnt1%
	Sel%=0
REM Use 5 of kind
	Cnt%=1
	WHILE Cnt% <=6
		IF Sort%(Cnt%)=5
			IF Psion%(12)<0 AND Cnt%<6
				Sel%=12
			ELSEIF Psion%(Cnt%)<0
				Sel%=Cnt%
			ELSEIF Psion%(8)<0
				Sel%=8
			ELSEIF Psion%(7)<0
				Sel%=7
			ELSEIF Psion%(13)<0 AND Cnt%>2
				Sel%=13
			ENDIF
		ENDIF
	Cnt%=Cnt%+1
	ENDWH
	IF Sel%>0
		GOTO Done::
	ENDIF

REM Use any Large Straight
	IF Psion%(11)<0
		IF Sort%(1)=1 AND Sort%(2)=1 AND Sort%(3)=1 AND Sort%(4)=1 AND Sort%(5)=1
			Sel%=11
		ELSEIF Sort%(2)=1 AND Sort%(3)=1 AND Sort%(4)=1 AND Sort%(5)=1 AND Sort%(6)=1
			Sel%=11
		ENDIF
	ENDIF
	IF Sel%>0
		GOTO Done::
	ENDIF

REM Use any Small Straight
	IF Psion%(10)<0
		IF Sort%(1)>0 AND Sort%(2)>0 AND Sort%(3)>0 AND Sort%(4)>0
			Sel%=10
		ELSEIF Sort%(2)>0 AND Sort%(3)>0 AND Sort%(4)>0 AND Sort%(5)>0
			Sel%=10
		ELSEIF Sort%(3)>0 AND Sort%(4)>0 AND Sort%(5)>0 AND Sort%(6)>0
			Sel%=10
		ENDIF
	ENDIF
	IF Sel%>0
		GOTO Done::
	ENDIF

REM Use 4 of kind
	Cnt%=1
	WHILE Cnt% <=6
		IF Sort%(Cnt%)=4
			IF Psion%(Cnt%)<0
				Sel%=Cnt%
			ENDIF
			IF Psion%(8)<0 AND (Cnt%<4 OR Sel%=0)
				Sel%=8
			ELSEIF Psion%(7)<0 AND Sel%=0
				Sel%=7
			ELSEIF Psion%(13)<0 AND Cnt%>2 AND Sel%=0
				Sel%=13
			ENDIF
		ENDIF
	Cnt%=Cnt%+1
	ENDWH
	IF Sel%>0
		GOTO Done::
	ENDIF
	
REM Look for Full House	
	cnt%=1
	WHILE cnt%<=6
		IF Sort%(cnt%)=2 AND Psion%(9)<0
			cnt1%=1
			WHILE cnt1%<=6
				IF Sort%(cnt1%)=3
					Sel%=9
				ENDIF
				cnt1%=cnt1%+1
			ENDWH
		ENDIF
		cnt%=cnt%+1
	ENDWH
	IF Sel%>0
		GOTO Done::
	ENDIF

REM use 3 of kind
	Cnt%=1
	WHILE Cnt% <=6
		IF Sort%(Cnt%)=3
			IF Psion%(Cnt%)<0
				Sel%=Cnt%
			ENDIF
			IF Psion%(7)<0 AND (Cnt%<4 OR Sel%=0)
				Sel%=7
			ELSEIF Psion%(13)<0 AND Cnt%>2 AND Sel%=0
				Sel%=13
			ENDIF
		ENDIF
	Cnt%=Cnt%+1
	ENDWH
	IF Sel%>0
		GOTO Done::
	ENDIF
	
REM Look for 2 of Kind
	Cnt%=6
	WHILE Cnt% >0
		IF Sort%(Cnt%)=2 AND Psion%(Cnt%)<0
			Sel%=Cnt%
		ENDIF
		Cnt%=Cnt%-1
	ENDWH	
	IF Psion%(13)<0 AND Sel%=0
		Sel%=13
	ENDIF
	IF Sel%>0
		GOTO Done::
	ENDIF

REM Find anything
	Cnt%=13
	WHILE cnt% >0
		IF Psion%(Cnt%)<0
			Sel%=Cnt%
		ENDIF
		Cnt%=Cnt%-1
	ENDWH
	
	
DONE::
	Psion%(Sel%)=Sel%
ENDP

PROC Score:
LOCAL Cnt1%
Point%=0
IF Sel%>0 AND Sel%<7
	Point%=Sort%(Sel%)*Sel%
ENDIF
cnt%=1
WHILE cnt% <=6
	IF Sel%=7 AND Sort%(cnt%)>=3
		Summ:
	ELSEIF Sel%=8 AND Sort%(Cnt%)>=4
		Summ:
	ELSEIF Sel%=12 AND Sort%(Cnt%)=5
		Point%=50
	ENDIF
	Cnt%=Cnt%+1
ENDWH
IF Sel%=9
	cnt%=1
	WHILE cnt%<=6
		IF Sort%(cnt%)=2
			cnt1%=1
			WHILE cnt1%<=6
				IF Sort%(cnt1%)=3
					Point%=25
				ENDIF
				cnt1%=cnt1%+1
			ENDWH
		ENDIF
		cnt%=cnt%+1
	ENDWH
ENDIF
IF Sel%=10
	IF Sort%(1)>0 AND Sort%(2)>0 AND Sort%(3)>0 AND Sort%(4)>0
		Point%=30
	ELSEIF Sort%(2)>0 AND Sort%(3)>0 AND Sort%(4)>0 AND Sort%(5)>0
		Point%=30
	ELSEIF Sort%(3)>0 AND Sort%(4)>0 AND Sort%(5)>0 AND Sort%(6)>0
		Point%=30
	ENDIF
ENDIF	
IF Sel%=11
	IF Sort%(1)=1 AND Sort%(2)=1 AND Sort%(3)=1 AND Sort%(4)=1 AND Sort%(5)=1
		Point%=40
	ELSEIF Sort%(2)=1 AND Sort%(3)=1 AND Sort%(4)=1 AND Sort%(5)=1 AND Sort%(6)=1
		Point%=40
	ENDIF
ENDIF
IF Sel%=13
	Summ:
ENDIF
Cx%=110
IF Sel%>6
	Cx%=364
ENDIF
IF Plyr%=2
	Cx%=Cx%+70
ENDIF
Cnt1%=Sel%
IF Sel%>6
	Cnt1%=Sel%-6
ENDIF
Cy%=68 + Cnt1%*11
gAT Cx%,Cy%
gPRINT Point%

ENDP

PROC SUMM:
	Point%=Sort%(1)+Sort%(2)*2+Sort%(3)*3+Sort%(4)*4+Sort%(5)*5+Sort%(6)*6
ENDP