YAHTZEE.BAS

YAHTZEE.BAS

'--------------------------
' Yahtzee Version 1.1
' Brian Hammond
' Finished: June 25, 1995
' Coded in: MS-QBasic 7.1
'--------------------------

'Initial Setup-------------------------------------------------------------

'make arrays static by usage of a MetaCommand (needs the comment)
'$STATIC

'default variable type DEF is an integer INT (DEFINT)
DEFINT A-Z

'Constants------------------------------------------------------------------

CONST white = 15
CONST black = 0: CONST blue = 1
CONST green = 2: CONST cyan = 3
CONST purple = 5: CONST red = 4
CONST brown = 6: CONST gray = 7
CONST skyblue = 9: CONST yellow = 14
CONST lrepeat = 8                            '# logo inner rectangles
CONST maxcol = 80                            'max width of screen
CONST str3 = 25                              'full house score
CONST str1 = 30                              'four straight
CONST str2 = 40                              'five straight

'Global Variables-----------------------------------------------------------

DIM SHARED newgame AS STRING * 2
DIM SHARED player1 AS STRING * 10
DIM SHARED player2 AS STRING * 10
DIM SHARED player3 AS STRING * 10
DIM SHARED player4 AS STRING * 10
DIM SHARED changes$
DIM SHARED numplayers
DIM SHARED lplacement
DIM SHARED x1, y1, x2, y2
DIM SHARED player, category
DIM SHARED die1, die2, die3, die4, die5
DIM SHARED roll.number
DIM SHARED one.counter, two.counter
DIM SHARED three.counter, four.counter
DIM SHARED five.counter, six.counter
DIM SHARED scores(1 TO 4, 1 TO 16)
DIM SHARED turn
DIM SHARED quit.counter
DIM SHARED yah.score

'Procedures/Functions------------------------------------------------------

DECLARE SUB blank (linenum)
DECLARE SUB board ()
DECLARE SUB center (row%, text$)
DECLARE SUB check.dice ()
DECLARE SUB graphic ()
DECLARE SUB intro ()
DECLARE SUB logo (lplacement, x1, y1, x2, y2)
DECLARE SUB place.score (turn)
DECLARE SUB play.game ()
DECLARE SUB player.turn (turn)
DECLARE SUB show.winner ()
DECLARE SUB update.score (turn, category)
DECLARE SUB user.input (numplayers, player1$, player2$, player3$, player4$)
DECLARE SUB yahtzee.scored ()
DECLARE FUNCTION roll% (n)
DECLARE FUNCTION certain$ (really.quit$)

'Module-Level Code---------------------------------------------------------

Main:
'screen mode set to VGA
 CLS : SCREEN 12

'if any other error, display message
 ON ERROR GOTO handler

'red fill-screen
 CALL intro

'main loop - ends when user doesn't enter "Y" to continue a newgame
DO
 CALL graphic
 CALL user.input(numplayers%, player1$, player2$, player3$, player4$)
 CALL board: CALL logo(lplacement, x1, 6, 625, 78)

'initialize scores array to equal 999 for every player's category scores.
'if it was not initialized to a value other than 0 (i.e. left alone) then
'the method to figure out if a player has scored in a certain category
'before reassigning a value to that category would be too difficult. A check
'to see if the value still = 999 is all that is needed now.
 FOR q = 1 TO 4
  FOR r = 1 TO 13
   scores(q, r) = 999
  NEXT
 NEXT

 FOR i = 1 TO 4
 'allow for multiple yahtzees to be scored in any category. To disable the
 '999 check, assign yahtzee another value, like 0.
  scores(i, 12) = 0
 NEXT

'indicate player's turn and start game
'set up a counter to quit when there are no more categories to score into.
 quit.counter = numplayers * 13
 turn = 1: CALL player.turn(turn): CALL play.game

'asks player if they want to play a new game
 CLS : COLOR white: center 10, "ENTER=NO  Y=YES"
 COLOR skyblue: center 11, STRING$(15, CHR$(205))
 COLOR gray: LOCATE 13, 32: INPUT "Play another? ", newgame$

 newgame$ = UCASE$(newgame$)
 IF INSTR(newgame$, "Y") THEN
  ERASE scores: CLS : COLOR white
 ELSE
  COLOR white: CLS : EXIT DO
 END IF

'reset variables if playing a newgame without program termination
 roll.number = 0
LOOP
END

'Subroutines for Module Level----------------------------------------------
handler:
 CLS
 FOR j = 1 TO 3
  FOR i = 1 TO 7
   COLOR i
   center 11, "ÕÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͸"
   center 12, "³   Sorry but Yahtzee has run into a problem on this computer...   ³"
   center 13, "ÔÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ;"
  NEXT
 NEXT
 SLEEP 2&
 RESUME 100

'end of module-based code
'return to operating system (DOS)
100 CLS

'--------------------------------------------------------------------------
'
' Blanks out the passed line number.
'
'--------------------------------------------------------------------------
SUB blank (linenum)
LOCATE linenum, 1: PRINT SPACE$(78)
END SUB

'--------------------------------------------------------------------------
'
' Draws the yahtzee board.
'
'--------------------------------------------------------------------------
SUB board

'The following section labels the scoring categories. There are 13 of them.
 CLS
 COLOR cyan
 LOCATE 9, 3: PRINT "1.  Ones: "
 LOCATE 10, 3: PRINT "2.  Twos: "
 LOCATE 11, 3: PRINT "3.  Threes: "
 LOCATE 12, 3: PRINT "4.  Fours: "
 LOCATE 13, 3: PRINT "5.  Fives: "
 LOCATE 14, 3: PRINT "6.  Sixes: "
 LOCATE 19, 3: PRINT "7.  Three of a kind: "
 LOCATE 20, 3: PRINT "8.  Four of a kind: "
 LOCATE 21, 3: PRINT "9.  Full House: "
 LOCATE 22, 3: PRINT "10. Four Straight: "
 LOCATE 23, 3: PRINT "11. Five Straight: "
 LOCATE 24, 3: PRINT "12. Yahtzee: "
 LOCATE 25, 3: PRINT "13. Potpourri: "

'sum (1-6) labels
 COLOR red: LOCATE 15, 3: PRINT "=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-="
 COLOR skyblue: LOCATE 16, 3: PRINT "Bonus 35 points if sum of fields 1-6 > 63"
 COLOR cyan: LOCATE 17, 3: PRINT CHR$(228)
 COLOR cyan: LOCATE 17, 4: PRINT "(1-6):"
 COLOR red: LOCATE 18, 3: PRINT "=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-="

'The following draws the dice holders
 COLOR skyblue
 LOCATE 8, 60: PRINT "The Dice"
 COLOR cyan
 column = 43
 FOR x = 1 TO 5
  column = column + 6
  LOCATE 10, column: PRINT "ÕÍÍ͸"
  LOCATE 11, column: PRINT "³   ³"
  LOCATE 12, column: PRINT "³ÍÍͳ"
  LOCATE 13, column: PRINT "³   ³"
  LOCATE 14, column: PRINT "ÔÍÍ;"
 NEXT

'The following draws the A-E labels for each die
 character = 64                             'ascii value of one less than "A"
 column.ii = 45                             'location across the screen
 COLOR brown                                'brown labels
 FOR y = 1 TO 5                             'a-e = 5
  column.ii = column.ii + 6
  character = character + 1
  LOCATE 11, column.ii: PRINT CHR$(character)
 NEXT

'The following draws the labels and names of those playing
 COLOR white: LOCATE 2, 2: PRINT "PLAYER 1: "
 COLOR green: LOCATE 3, 2: PRINT player1$
 COLOR cyan: LOCATE 5, 2: PRINT "SCORE: "
 x1% = 105
 lplacement = 43

 IF numplayers > 1 THEN
  COLOR white: LOCATE 2, 15: PRINT "PLAYER 2: "
  COLOR red: LOCATE 3, 15: PRINT player2$
  COLOR cyan: LOCATE 5, 15: PRINT "SCORE: "
  x1% = 205
  lplacement = 50
 END IF

 IF numplayers > 2 THEN
  COLOR white: LOCATE 2, 27: PRINT "PLAYER 3: "
  COLOR brown: LOCATE 3, 27: PRINT player3$
  COLOR cyan: LOCATE 5, 27: PRINT "SCORE: "
  x1% = 305
  lplacement = 57
 END IF

 IF numplayers > 3 THEN
  COLOR white: LOCATE 2, 40: PRINT "PLAYER 4: "
  COLOR yellow: LOCATE 3, 40: PRINT player4$
  COLOR cyan: LOCATE 5, 40: PRINT "SCORE: "
  x1% = 405
  lplacement = 62
 END IF

'prints dashes in category score positions so that the users can
'see which categories they can score into
 FOR i = 9 TO 14
  FOR j = 26 TO 38 STEP 4: LOCATE i, j + 1: PRINT "-": NEXT
 NEXT

'sums (1-6)
 FOR k = 26 TO 38 STEP 4: LOCATE 17, k + 1: PRINT "-": NEXT

'lower half of categories
 FOR l = 19 TO 25
  FOR m = 26 TO 38 STEP 4: LOCATE l, m + 1: PRINT "-": NEXT
 NEXT

'individual scoring category labels for each player
 COLOR 10: LOCATE 7, 31: PRINT "Player"
 COLOR skyblue: LOCATE 7, 3: PRINT "Scoring Categories"
 COLOR red: LOCATE 24, 50: PRINT "ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ"
 COLOR green: LOCATE 8, 27: PRINT "1"
 LOCATE 8, 31: PRINT "2"
 LOCATE 8, 35: PRINT "3"
 LOCATE 8, 39: PRINT "4"
 COLOR white

'The following case structure blacks out the labels of those not
'playing. If left alone, these labels would remain behind the logo.
 SELECT CASE numplayers
 CASE IS = 1
  LINE (102, 2)-(397, 80), 0, BF
 CASE IS = 2
  LINE (202, 2)-(397, 80), 0, BF
 CASE IS = 3
  LINE (302, 2)-(397, 80), 0, BF
 CASE IS = 4
  'nothing needed for 4 players
 END SELECT

'middle screen separator
 LINE (365, 90)-(365, 400), cyan, B
 LINE (367, 90)-(367, 400), red, B
 LINE (369, 90)-(369, 400), cyan, B

'player info separator from game area
 LINE (1, 83)-(630, 83), gray, B

'bottom screen separator top
 LINE (1, 412)-(630, 412), gray, B
'bottom screen separator bottom
 LINE (1, 470)-(630, 470), gray, B

'the player turn indicator
 LOCATE 23, 50: COLOR gray: PRINT "Player Turn: "

'print initial total scores of those playing
 COLOR white
 LOCATE 5, 8: PRINT scores(1, 15)
 IF numplayers > 1 THEN : LOCATE 5, 21: PRINT scores(2, 15)
 IF numplayers > 2 THEN : LOCATE 5, 33: PRINT scores(3, 15)
 IF numplayers > 3 THEN : LOCATE 5, 46: PRINT scores(4, 15)

END SUB

'--------------------------------------------------------------------------
'
' Centers a string and prints it given the row it will be placed on
' by the row% (integer) parameter
'
'--------------------------------------------------------------------------
SUB center (row%, text$)
 col = maxcol \ 2
 LOCATE row, col - (LEN(text$) / 2 + .5)
 PRINT text$;
END SUB

'--------------------------------------------------------------------------
'
' Asks the user if they are sure they want to quit all player's games
'
'--------------------------------------------------------------------------
FUNCTION certain$ (really.quit$)
 blank (28)
 LOCATE 25, 50: PRINT "             "
 COLOR white: LOCATE 28, 30: PRINT "Do you really want to quit? "
 COLOR white: LOCATE 28, 58: INPUT "", really.quit$
 blank (28)
 certain$ = really.quit$
END FUNCTION

'--------------------------------------------------------------------------
'
' Accumulates counters for each possible value based on the current value
' of the five dice. Rolling 1 5 5 6 4 would give the 1 counter a value of
' 1, the 5 counter a value of 2, the six counter a value of 1, etc.
'
'--------------------------------------------------------------------------
SUB check.dice
'$STATIC
DIM dice(5) AS INTEGER
dice(1) = die1: dice(2) = die2: dice(3) = die3: dice(4) = die4: dice(5) = die5

FOR i = 1 TO 5
 SELECT CASE dice(i)
 CASE IS = 1
  one.counter = one.counter + 1
 CASE IS = 2
  two.counter = two.counter + 1
 CASE IS = 3
  three.counter = three.counter + 1
 CASE IS = 4
  four.counter = four.counter + 1
 CASE IS = 5
  five.counter = five.counter + 1
 CASE IS = 6
  six.counter = six.counter + 1
 END SELECT
NEXT

'done with temp array so reinitialize its indices to zero
ERASE dice
END SUB

'--------------------------------------------------------------------------
'
' Draws a rotating square on screen the name input screen (sub users)
'
'--------------------------------------------------------------------------
SUB graphic
 Move$ = "D75 L65"                    'move cursor w/o drawing anything
 Object1$ = "R100 D100 L100 U100"     'a square defined
 DRAW "B X" + VARPTR$(Move$)          'move cursor again
 DRAW "C6 X" + VARPTR$(Object1$)      'frame defined square in color ('C')
                                      'brown ('6')
 DRAW "TA10 X" + VARPTR$(Object1$)    'rotate ('TA') # degrees ('10-60')
 DRAW "TA20 X" + VARPTR$(Object1$)    'and draw the new object pointed to
 DRAW "TA30 X" + VARPTR$(Object1$)    'by the string pointer 'VARPTR$'
 DRAW "TA40 X" + VARPTR$(Object1$)
 DRAW "TA50 X" + VARPTR$(Object1$)
 DRAW "TA60 X" + VARPTR$(Object1$)
END SUB

'--------------------------------------------------------------------------
'
' This procedure sets up the random sequence of red rectangles for a
' "fill" effect using GET and PUT
'
'--------------------------------------------------------------------------
SUB intro
'initialize the array to hold 500 integer values
 DIM box%(1 TO 500)

'set up the 3x3 pixel rectangle values
 a1% = 1: a2% = 3: b1% = 1: b2% = 3

'draw a rectangle using these values
 LINE (a1, b1)-(a2, b2), red, BF

'take a picture of values in array
 GET (a1, b1)-(a2, b2), box%

'loop takes values from get and puts them onto the screen somewhere between
'pixels 1 and 629 across and 1 and 469 down. The screen resolution this is
'made for is 640 x 480 pixels. However, the entire screen can't be used since
'the rectangles cannot be displayed with a portion of it off the screen and
'a portion on. Since, the length is only 3 pixels, this problem doesn't come
'about.

 DO: LOCATE 13, 38: PRINT "Yahtzee"
  LOCATE 14, 35: PRINT "Brian Hammond"
  COLOR gray: LOCATE 17, 29: PRINT "Press any key to continue": COLOR white
  PUT (a1, b1), box%, AND
  a1 = RND * 629: b1 = RND * 469
  PUT (a1, b1), box%
 LOOP WHILE INKEY$ = "": CLS
END SUB

'--------------------------------------------------------------------------
'
' This procedure draws the Yahtzee logo on the board. The passed parameters
' of lrepeat, x1, x2, y1, y2, and lplacement determine the location of the
' logo based on the number of players. lrepeat = 8.
'
'--------------------------------------------------------------------------
SUB logo (lplacement, x1, y1, x2, y2)
 FOR i = 1 TO lrepeat
  'give the inner rectangles random colors (+ 1 to guard fom black)
  rect.color = INT(RND * 15) + 1

  'draw the rectangles
  LINE (x1, y1)-(x2, y2), rect.color, B

  'move coordinates so next rectangle is inside the previous one
  x1 = x1 + 5: y1 = y1 + 5: x2 = x2 - 5: y2 = y2 - 5
 NEXT

 'reset original top,bottom, right coords.
 y1 = 6: x2 = 625: y2 = 78
 COLOR 15: LOCATE 3, lplacement%: PRINT "YAHTZEE"
END SUB

'--------------------------------------------------------------------------
'
' Prompts user for category to score into and based on counter values
' returned by check.dice, allows/disallows credit for the category. The
' players category score, total score, and sum score (if category < 7)
' are updated. Counters are reset @ the end of this sub.
'
' Refer to the main module for an explanation on the use of 999.
'
'--------------------------------------------------------------------------
SUB place.score (turn)
'prompt user for category to score into - label 10 used for errors,
'as in the user entered an invalid category and must repeat entry.

10
 DO
  blank (28): LOCATE 25, 50: PRINT "        "
  COLOR white: LOCATE 28, 30: INPUT "Score into which category? ", where$
 LOOP UNTIL VAL(where$) > 0 AND VAL(where$) <= 13

 where = VAL(where$)
 SELECT CASE where

'****************************************************************************
' 1-6 = ones .. sixes
'****************************************************************************

 CASE IS = 1
  GOSUB errorcheck: IF duplicate = 1 THEN GOTO 10
  GOSUB check.yahtzee
  temp.counter = one.counter: whichlowcat = 1: GOSUB lowcat

 CASE IS = 2
  GOSUB errorcheck: IF duplicate = 1 THEN GOTO 10
  GOSUB check.yahtzee
  temp.counter = two.counter: whichlowcat = 2: GOSUB lowcat

 CASE IS = 3
  GOSUB errorcheck: IF duplicate = 1 THEN GOTO 10
  GOSUB check.yahtzee
  temp.counter = three.counter: whichlowcat = 3: GOSUB lowcat

 CASE IS = 4
  GOSUB errorcheck: IF duplicate = 1 THEN GOTO 10
  GOSUB check.yahtzee
  temp.counter = four.counter: whichlowcat = 4: GOSUB lowcat

 CASE IS = 5
  GOSUB errorcheck: IF duplicate = 1 THEN GOTO 10
  GOSUB check.yahtzee
  temp.counter = five.counter: whichlowcat = 5: GOSUB lowcat

 CASE IS = 6
  GOSUB errorcheck: IF duplicate = 1 THEN GOTO 10
  GOSUB check.yahtzee
  temp.counter = six.counter: whichlowcat = 6: GOSUB lowcat

'****************************************************************************
' 7 = three of a kind
'****************************************************************************

 CASE IS = 7
  GOSUB errorcheck: IF duplicate = 1 THEN GOTO 10
  GOSUB check.yahtzee
  IF one.counter > 2 OR two.counter > 2 OR three.counter > 2 OR four.counter > 2 OR five.counter > 2 OR six.counter > 2 THEN
   scores(turn, 7) = (one.counter * 1) + (two.counter * 2) + (three.counter * 3) + (four.counter * 4) + (five.counter * 5) + (six.counter * 6)
  ELSE
   scores(turn, 7) = 0
  END IF
  CALL update.score(turn, 7)

'****************************************************************************
' 8 = four of a kind
'****************************************************************************

 CASE IS = 8
  GOSUB errorcheck: IF duplicate = 1 THEN GOTO 10
  GOSUB check.yahtzee
  IF one.counter > 3 OR two.counter > 3 OR three.counter > 3 OR four.counter > 3 OR five.counter > 3 OR six.counter > 3 THEN
   scores(turn, 8) = (one.counter * 1) + (two.counter * 2) + (three.counter * 3) + (four.counter * 4) + (five.counter * 5) + (six.counter * 6)
  ELSE
   scores(turn, 8) = 0
  END IF
  CALL update.score(turn, 8)
 
'****************************************************************************
' 9 = full house
'****************************************************************************

 CASE IS = 9
  GOSUB errorcheck: IF duplicate = 1 THEN GOTO 10
  GOSUB check.yahtzee

'the checks for the pairs of a full house
  IF one.counter = 2 THEN pair = 1
  IF two.counter = 2 THEN pair = 1
  IF three.counter = 2 THEN pair = 1
  IF four.counter = 2 THEN pair = 1
  IF five.counter = 2 THEN pair = 1
  IF six.counter = 2 THEN pair = 1

'check for the three of a kind in a full house
  IF one.counter = 3 THEN triple = 1
  IF two.counter = 3 THEN triple = 1
  IF three.counter = 3 THEN triple = 1
  IF four.counter = 3 THEN triple = 1
  IF five.counter = 3 THEN triple = 1
  IF six.counter = 3 THEN triple = 1

  IF pair = 1 AND triple = 1 THEN
   scores(turn, 9) = str3
  ELSE
   scores(turn, 9) = 0
  END IF
  CALL update.score(turn, 9)

'****************************************************************************
' 10 = four straight
'****************************************************************************

 CASE IS = 10
  GOSUB errorcheck: IF duplicate = 1 THEN GOTO 10
  GOSUB check.yahtzee
  '1234 check
  IF one.counter > 0 AND two.counter > 0 AND three.counter > 0 AND four.counter > 0 THEN
   scores(turn, 10) = str1
  '2345 check
  ELSEIF two.counter > 0 AND three.counter > 0 AND four.counter > 0 AND five.counter > 0 THEN
   scores(turn, 10) = str1
  '3456 check
  ELSEIF three.counter > 0 AND four.counter > 0 AND five.counter > 0 AND six.counter > 0 THEN
   scores(turn, 10) = str1
  ELSE
   scores(turn, 10) = 0
  END IF
  CALL update.score(turn, 10)

'****************************************************************************
' 11 = five straight
'****************************************************************************

 CASE IS = 11
  GOSUB errorcheck: IF duplicate = 1 THEN GOTO 10
  GOSUB check.yahtzee
  '12345 check
  IF one.counter > 0 AND two.counter > 0 AND three.counter > 0 AND four.counter > 0 AND five.counter > 0 THEN
   scores(turn, 11) = str2
  '23456
  ELSEIF two.counter > 0 AND three.counter > 0 AND four.counter > 0 AND five.counter > 0 AND six.counter > 0 THEN
   scores(turn, 11) = str2
  ELSE
   scores(turn, 11) = 0
  END IF
  CALL update.score(turn, 11)

'****************************************************************************
' 12 = yahtzee
'****************************************************************************

 CASE IS = 12
  GOSUB errorcheck: IF duplicate = 1 THEN GOTO 10

  IF one.counter > 4 OR two.counter > 4 OR three.counter > 4 OR four.counter > 4 OR five.counter > 4 OR six.counter > 4 THEN
   scores(turn, 16) = scores(turn, 16) + 1
  
   IF scores(turn, 16) > 0 THEN
    yah.score = 50
   ELSEIF scores(turn, 16) > 1 THEN
    yah.score = 100
   END IF
  
   CALL yahtzee.scored
 
  ELSE
   scores(turn, 12) = 0
  END IF
 
  CALL update.score(turn, 12)
 
'****************************************************************************
' 13 = potpourri
'****************************************************************************

 CASE IS = 13
  GOSUB errorcheck: IF duplicate = 1 THEN GOTO 10
  GOSUB check.yahtzee
  scores(turn, 13) = die1 + die2 + die3 + die4 + die5 + die6
  CALL update.score(turn, 13)
 END SELECT

'****************************************************************************
' end of category case
'****************************************************************************

'go to next player
 turn = turn + 1
 IF numplayers = 1 THEN turn = 1
 IF numplayers = 2 AND turn > 2 THEN turn = 1
 IF numplayers = 3 AND turn > 3 THEN turn = 1
 IF turn > 4 THEN turn = 1
 CALL player.turn(turn)

'reset counters for next roll
 one.counter = 0: two.counter = 0: three.counter = 0
 four.counter = 0: five.counter = 0: six.counter = 0

 CALL blank(28)

'this counter quits the game and calls sub winner when there are no more
'places to place a score, i.e. the game is over
 quit.counter = quit.counter - 1
 IF quit.counter <= 0 THEN changes$ = "Q": CALL show.winner

'exit since following subroutines are called specifically from above and
'would be called and extra time if exit sub wasn't here.
 EXIT SUB

'checks to see if player is trying to overwrite an old score. If messaging
'is on, and the player is overwriting, display a message and then ask for a
'new category to score into. If messaging is off, just return control to
'input.

errorcheck:
 IF where = 12 THEN
  'initialized to zero, if not zero now... don't score there
  IF scores(turn, 12) <> 0 THEN
    duplicate = 1
    GOTO 75
  ELSE
    duplicate = 0
    GOTO 75
  END IF

 ELSEIF scores(turn, where) = 999 THEN
  duplicate = 0
 ELSE
  duplicate = 1
 END IF
75 RETURN

'runs the scoring for categories 1-6

lowcat:
 scores(turn, whichlowcat) = temp.counter * whichlowcat
 CALL update.score(turn, whichlowcat)
RETURN

'checks to see if a yahtzee is being scored.

check.yahtzee:
 IF one.counter > 4 OR two.counter > 4 OR three.counter > 4 OR four.counter > 4 OR five.counter > 4 OR six.counter > 4 THEN
  IF scores(turn, 12) = 0 THEN GOTO 90
  scores(turn, 16) = scores(turn, 16) + 1
  CALL yahtzee.scored
 END IF
90 RETURN

END SUB

'--------------------------------------------------------------------------
'
' This is the main loop which handles user input on what action
' is to be taken. Valid input includes:
'
'   1. Any combination of A,B,C,D,E to roll those dice
'   2. Q to quit
'   3. ENTER to score the roll
'
'--------------------------------------------------------------------------
SUB play.game

DO
20 'label to return to when roll # > 3

 IF quit.counter <= 0 THEN EXIT SUB

'increment roll number after each loop
 roll.number = roll.number + 1

'Roll Handler -------------------------------------------------------------
'Each player's 1st roll is automatically taken rolling all 5 dice

 IF roll.number = 1 THEN
  die1 = roll(n): die2 = roll(n)
  die3 = roll(n): die4 = roll(n): die5 = roll(n)
  GOSUB display.dice: GOTO 20
 END IF

'--------------------------------------------------------------------------
'The 2 extra rerolls handler

 IF roll.number > 1 AND roll.number <= 3 THEN
  COLOR white: LOCATE 25, 50: LINE INPUT "Changes? "; changes$
  changes$ = LEFT$(UCASE$(changes$), 5)

'if any of the following letters are found in what the user entered,
'then set a flag for the die in question as 1, i.e. roll that die
  IF INSTR(changes$, "A") THEN a = 1 ELSE a = 0
  IF INSTR(changes$, "B") THEN B = 1 ELSE B = 0
  IF INSTR(changes$, "C") THEN c = 1 ELSE c = 0
  IF INSTR(changes$, "D") THEN d = 1 ELSE d = 0
  IF INSTR(changes$, "E") THEN e = 1 ELSE e = 0

'the following determines which dice to roll and calls the function
'roll(die) to roll them.
  IF a = 1 THEN die1 = roll(n)
  IF B = 1 THEN die2 = roll(n)
  IF c = 1 THEN die3 = roll(n)
  IF d = 1 THEN die4 = roll(n)
  IF e = 1 THEN die5 = roll(n)

'If changes$ = a blank, as in enter was hit, the player wants to score roll
  IF changes$ = "" THEN
   GOSUB display.dice: CALL check.dice: CALL place.score(turn)
   roll.number = 0: GOTO 20
  END IF

'if "Q" was entered, user(s) wants to quit all player's games
'ask for certainty, then quit or return here if not quitting
  IF INSTR(changes$, "Q") THEN
   really.quit$ = certain$(really.quit$)
   really.quit$ = UCASE$(really.quit$)
   IF INSTR(really.quit$, "Y") THEN EXIT DO
   IF roll.number > 1 THEN roll.number = roll.number - 1
   LOCATE 25, 59: PRINT "      ": GOTO 20
  END IF

'clear last changes$ value entered
  LOCATE 25, 59: PRINT "         "

'the following tells user what went wrong with what they entered for changes
'note: checks to see if messaging is enabled first.
 
  IF INSTR(changes$, "A") = 0 AND INSTR(changes$, "B") = 0 AND INSTR(changes$, "C") = 0 AND INSTR(changes$, "D") = 0 AND INSTR(changes$, "E") = 0 AND INSTR(changes$, "Q") = 0 THEN
   roll.number = roll.number - 1
   GOTO 20
  END IF

'end of if roll.number > 1 and < 3
 GOSUB display.dice
 END IF

'--------------------------------------------------------------------------
'If Player has used up both additional rolls, jump to score the current dice
'values

 IF roll.number > 3 THEN
  CALL check.dice
  CALL place.score(turn)
  roll.number = 0: GOTO 20
 END IF

LOOP

'skip subroutine being called upon exiting loop
EXIT SUB

'subroutine: display dice values returned by function roll

display.dice:
 COLOR white:
 LOCATE 13, 50: PRINT die1
 LOCATE 13, 56: PRINT die2
 LOCATE 13, 62: PRINT die3
 LOCATE 13, 68: PRINT die4
 LOCATE 13, 74: PRINT die5
RETURN

END SUB

'--------------------------------------------------------------------------
'
' Shows users who goes by 1) a blue box around the player's name on top
'                         2) the name near the CHANGES? prompt
'                         3) the column header of category scores of
'                            the player's turn in yellow
'
'--------------------------------------------------------------------------
SUB player.turn (turn)
'first indicator
 SELECT CASE turn
 CASE IS = 1
  SELECT CASE numplayers
  CASE IS = 1
   LINE (2, 2)-(97, 80), skyblue, B          'frame 1
  CASE IS = 2
   LINE (102, 2)-(197, 80), black, B        'erase 2
   LINE (2, 2)-(97, 80), skyblue, B          'frame 1
  CASE IS = 3
   LINE (202, 2)-(297, 80), black, B        'erase 3
   LINE (2, 2)-(97, 80), skyblue, B          'frame 1
  CASE IS = 4
   LINE (302, 2)-(397, 80), black, B        'erase 4
   LINE (2, 2)-(97, 80), skyblue, B          'frame 1
  END SELECT
 CASE IS = 2
  LINE (2, 2)-(97, 80), black, B            'erase 1
  LINE (102, 2)-(197, 80), skyblue, B
 CASE IS = 3
  LINE (2, 2)-(97, 80), black, B            'erase 1
  LINE (102, 2)-(197, 80), black, B         'erase 2
  LINE (202, 2)-(297, 80), skyblue, B
 CASE IS = 4
  LINE (2, 2)-(97, 80), black, B            'erase 1
  LINE (102, 2)-(197, 80), black, B         'erase 2
  LINE (202, 2)-(297, 80), black, B         'erase 3
  LINE (302, 2)-(397, 80), skyblue, B
 END SELECT

'second indicator

 COLOR white
 SELECT CASE turn
 CASE IS = 1
  x$ = SPACE$(10): LOCATE 23, 63: PRINT x$
  LOCATE 23, 63: PRINT player1$
 CASE IS = 2
  x$ = SPACE$(10): LOCATE 23, 63: PRINT x$
  LOCATE 23, 63: PRINT player2$
 CASE IS = 3
  x$ = SPACE$(10): LOCATE 23, 63: PRINT x$
  LOCATE 23, 63: PRINT player3$
 CASE IS = 4
  x$ = SPACE$(10): LOCATE 23, 63: PRINT x$
  LOCATE 23, 63: PRINT player4$
 END SELECT

'third indicator

 IF turn = 1 THEN
  COLOR yellow: LOCATE 8, 27: PRINT "1"
 ELSE
  COLOR green: LOCATE 8, 27: PRINT "1"
 END IF

 IF turn = 2 THEN
  COLOR yellow: LOCATE 8, 31: PRINT "2"
 ELSE
  COLOR green: LOCATE 8, 31: PRINT "2"
 END IF

 IF turn = 3 THEN
  COLOR yellow: LOCATE 8, 35: PRINT "3"
 ELSE
  COLOR green: LOCATE 8, 35: PRINT "3"
 END IF

 IF turn = 4 THEN
  COLOR yellow: LOCATE 8, 39: PRINT "4"
 ELSE
  COLOR green: LOCATE 8, 39: PRINT "4"
 END IF

END SUB

'--------------------------------------------------------------------------
'
' This function rolls a dice returning the value rolled.
'
'--------------------------------------------------------------------------
FUNCTION roll (n)
'roll die and give the function a return value
 RANDOMIZE TIMER: die = INT(RND * 6) + 1: roll = die
END FUNCTION

'--------------------------------------------------------------------------
'
' Shows users who winner is based on total score. If only one player,
' this tells that player the game is over. called if no user quits
' before the end of the game.
'
'--------------------------------------------------------------------------
SUB show.winner
'erase player turn... goes back to player 1 when game is over.
 LOCATE 23, 63: PRINT "                "

'make category player highlight green
 COLOR green: LOCATE 8, 27: PRINT "1"

'erase all boxes on top
 LINE (2, 2)-(97, 80), black, B             'erase 1

 IF numplayers > 1 THEN
  LINE (102, 2)-(197, 80), black, B         'erase 2
 END IF

 IF numplayers > 2 THEN
  LINE (202, 2)-(297, 80), black, B         'erase 3
 END IF

 IF numplayers > 3 THEN
  LINE (302, 2)-(397, 80), black, B         'erase 4
 END IF


 extent = 68: x$ = SPACE$(1): r = 2
 FOR j = 1 TO 33
  COLOR yellow: LOCATE 28, extent: PRINT "GAME OVER!"
  LOCATE 28, extent + 10: PRINT " "
  extent = extent - 1: r = r + 1
 NEXT
 SLEEP 2&

IF numplayers > 1 THEN
 COLOR white: center 28, "The winner is... ": SLEEP 2&

 IF scores(1, 15) < scores(2, 15) THEN
  IF scores(2, 15) > scores(3, 15) THEN
   IF scores(2, 15) > scores(4, 15) THEN
    winner$ = player2$
 END IF
  ELSEIF scores(2, 15) < scores(3, 15) THEN
   IF scores(3, 15) > scores(4, 15) THEN
    winner$ = player3$
   ELSEIF scores(3, 15) < scores(4, 15) THEN
    winner$ = player4$
   END IF
  END IF
 ELSEIF scores(1, 15) > scores(2, 15) THEN
  IF scores(1, 15) > scores(3, 15) THEN
   IF scores(1, 15) > scores(4, 15) THEN
    winner$ = player1$
   END IF
  END IF
 ELSE
  winner$ = "No one wins because you all played so poorly."
 END IF

 FOR i = 1 TO 50: FOR j = 1 TO 9: COLOR j: LOCATE 28, 48: PRINT winner$: NEXT: NEXT
 DO: LOOP UNTIL INKEY$ <> ""

END IF
END SUB

'--------------------------------------------------------------------------
'
' Takes as parameters player # and category and updates the category score
' after accessing the correct position in the 4-D "scores" array.
'    row.score    = row position of each category
'    column.score = column position of category based on which player
'    total.column = total score column position based on player
'    total.score  = score displayed at the top of the screen
'
'--------------------------------------------------------------------------
SUB update.score (turn, category)
'this case determines which row the score will be displayed on, based on
'which category is being updated
 IF category < 7 THEN row.score = category + 8 ELSE row.score = category + 12

'this case determines which column the score to be updated will be displayed
'in based on which player's turn it currently is.
 SELECT CASE turn
 CASE IS = 1
  column.score = 26
 CASE IS = 2
  column.score = 30
 CASE IS = 3
  column.score = 34
 CASE IS = 4
  column.score = 38
 END SELECT

'update sum (1-6) if necc.
 IF category < 7 THEN
  FOR k = 1 TO 6
   IF scores(turn, k) <> 999 THEN
    sum = sum + scores(turn, k)
   END IF
  NEXT
  scores(turn, 14) = sum
 END IF

'bonus for a sum (1-6) greater than 63
 IF scores(turn, 14) > 63 THEN
  total.score = total.score + 35
 END IF

'check for yahtzees to be added in to the total score
 IF scores(turn, 16) > 0 AND scores(turn, 12) = 0 THEN
  scores(turn, 12) = scores(turn, 12) + 50

 ELSEIF scores(turn, 16) > 1 THEN
  scores(turn, 12) = (scores(turn, 16) * 100) - 50
 END IF

'show the yahtzee category if something was scored there
 IF scores(turn, 12) <> 0 THEN
  IF scores(turn, 12) > 99 THEN column.score = column.score - 1
  COLOR white: LOCATE 24, column.score - 1: PRINT scores(turn, 12)
  IF scores(turn, 12) > 99 THEN column.score = column.score + 1
 END IF

'always update the total score (top [1-6] + bottom [7-13])
 FOR i = 7 TO 13:
  IF scores(turn, i) <> 999 THEN
   total.score = total.score + scores(turn, i)
  END IF
 NEXT
 'total score = top sum + bottom sum or rather [scores(turn,14) + total.score]
 scores(turn, 15) = total.score + scores(turn, 14)

'print updated category score
 IF scores(turn, category) > 9 THEN column.score = column.score - 1
 COLOR white: LOCATE row.score, column.score: PRINT scores(turn, category)
 IF scores(turn, category) > 9 THEN column.score = column.score + 1

'print sum if necc.
 IF scores(turn, 14) > 9 THEN column.score = column.score - 1
 IF scores(turn, 14) > 99 THEN column.score = column.score - 1
 IF category < 7 THEN : LOCATE 17, column.score: PRINT scores(turn, 14)
 IF scores(turn, 14) > 9 THEN column.score = column.score + 1
 IF scores(turn, 14) > 99 THEN column.score = column.score + 1

'print total.scores of those playing
 LOCATE 5, 8: PRINT scores(1, 15)
 IF numplayers > 1 THEN : LOCATE 5, 21: PRINT scores(2, 15)
 IF numplayers > 2 THEN : LOCATE 5, 33: PRINT scores(3, 15)
 IF numplayers > 3 THEN : LOCATE 5, 46: PRINT scores(4, 15)

'reset temps for next usage
 sum = 0: total.score = 0

'flash logo to show score has been updated
 x1 = numplayers * 100 + 5: x2 = 625: y1 = 6: y2 = 78
 CALL logo(lplacement, x1, y1, x2, y2)
END SUB

'--------------------------------------------------------------------------
'
' This procedure asks the user(s) how many people are playing, and then
' asks each player for their name.
'
'--------------------------------------------------------------------------
SUB user.input (numplayers%, player1$, player2$, player3$, player4$)

'number playing
 DO
  LOCATE 5, 24: INPUT "How many players (1 to 4)"; num$
 LOOP UNTIL VAL(num$) >= 1 AND VAL(num$) <= 4
 numplayers = VAL(num$)
 COLOR black: LOCATE 5, 24: PRINT "                            "

'names
 COLOR green
 LOCATE 5, 24
 LINE INPUT "Name of Player 1 <Player 1>: "; player1$
 IF player1$ = "" THEN
   player1$ = "Player 1"
 ELSE
   player1$ = LEFT$(player1$, 9)
 END IF

 COLOR red
 IF numplayers > 1 THEN
  LOCATE 7, 24
  LINE INPUT "Name of Player 2 <Player 2>: "; player2$
  IF player2$ = "" THEN
    player2$ = "Player 2"
  ELSE
    player2$ = LEFT$(player2$, 10)
  END IF
 END IF

 COLOR brown
 IF numplayers > 2 THEN
  LOCATE 9, 24
  LINE INPUT "Name of Player 3 <Player 3>: "; player3$
  IF player3$ = "" THEN
    player3$ = "Player 3"
  ELSE
    player3$ = LEFT$(player3$, 10)
  END IF
 END IF

 COLOR yellow
 IF numplayers > 3 THEN
  LOCATE 11, 24
  LINE INPUT "Name of Player 4 <Player 4>: "; player4$
  IF player4$ = "" THEN
    player4$ = "Player 4"
  ELSE
    player4$ = LEFT$(player4$, 10)
  END IF
 END IF

'make all user names uppercase
 player1$ = UCASE$(player1$)
 player2$ = UCASE$(player2$)
 player3$ = UCASE$(player3$)
 player4$ = UCASE$(player4$)

'reset color to white
 COLOR white
END SUB

'--------------------------------------------------------------------------
'
' Flashes Yahtzee! whenever a player gets a yahtzee.
'
'--------------------------------------------------------------------------
SUB yahtzee.scored

 blank (28): x$ = SPACE$(1): r = 3: extent = 67

 FOR h = 1 TO 10
  FOR i = 1 TO extent
   COLOR r: LOCATE 28, i + 1: PRINT "Yahtzee!"
   LOCATE 28, i: PRINT x$
  NEXT
  r = r + 1: extent = extent - 9
 NEXT

 SLEEP 2&
END SUB