!********o*********o*********o*********o*********o*********o*********o** ! This program allows to players to play a game that is intended to ! be a crude model of basketball. The idea was originally implemented ! on programmable calculators in the early days of that technology. ! The simulation uses fortran's pseudo-random number generator. ! ! It's purpose for this class is as a demonstration of a 'menu-driven' ! user interface. ! ! Inputs ! A series of choices from the players. ! ! Outputs ! A series of status updates shown to the players. !--------------------- ! Author: Bob Harris ! Class: CMPSC 201F ! Section: 1234 ! Date Due: 29 Oct 2003 !********o*********o*********o*********o*********o*********o*********o** program hoops1977 implicit none ! game configuration integer, parameter :: gameSeconds = 40*60 ! 40 minute game integer, parameter :: overtimeSeconds = 5*60 ! 5 minute overtime(s) real, parameter :: stealChance = 0.25 ! chance pass is stolen real, parameter :: reboundChance = 0.10 ! chance of rebound ! current 'state' of the game integer :: whosBall ! which player has the ball (1 or 2) integer :: score1, score2 ! current score for each player integer :: secondsLeft ! number of seconds remaining in the game integer :: mins, secs ! working variables to display clock real :: shotChance ! chance of making current shot (0..1) integer :: pct ! working variables to display chance ! player commands integer :: command ! the latest command from the current player integer :: pendingCommand ! a command we'll perform without asking integer, parameter :: noCommand = 0 integer, parameter :: quitGame = 1 integer, parameter :: newGame = 2 integer, parameter :: pass = 3 integer, parameter :: shoot = 4 integer, parameter :: gameIsOver = -1 ! other variables logical :: prngReady ! true => we've set up pseudo random number generator ! false => we haven't real :: r ! a random number, 0.0 <= r < 1.0 logical :: takeTheShot ! true => take the shot we have ! false => don't logical :: lookForShot ! true => pass ball to get open shot ! false => don't !---------- ! continually loop, processing commands until players decide to quit !---------- prngReady = .false. ! indicate that we need to initialize the pseudo ! ... random number generator pendingCommand = newGame ! force a new game first time through loop do !---------- ! decide what to do next !---------- ! if we have a command pending, we'll do that if (pendingCommand /= noCommand) then command = pendingCommand pendingCommand = noCommand ! otherwise, check to see if the game has just finished else if (secondsLeft <= 0) then command = gameIsOver pendingCommand = newGame ! otherwise, ask the current player what to do else mins = secondsLeft / 60 secs = secondsLeft - (mins*60) pct = INT (0.5 + (100 * shotChance)) ! round to nearest % print *, "--------------" print '(1X,A,I3)', "Player 1 score: ", score1 print '(1X,A,I3)', "Player 2 score: ", score2 print '(1X,A,I3,A,I2.2)', "Time Left: ", mins,":",secs print '(1X,A,I3,A)', "You are open for a ",pct,"% shot" print '(1X,A,I1,A)', "Player *", whosBall, "*, what shall we do?" print '(3X,I1,A)', quitGame, ": take my ball and go home" print '(3X,I1,A)', newGame, ": start a new game" print '(3X,I1,A)', pass, ": look for another shot" print '(3X,I1,A)', shoot, ": take that shot" read *, command end if !---------- ! if she wants to quit, exit the loop !---------- if (command == quitGame) exit !---------- ! perform the command !---------- takeTheShot = .false. lookForShot = .false. select case (command) !--- if the user gives a command we don't know, tell her --- case default print *, "I have no idea what you want me to do" !--- newGame: initialize the state of the game --- case (newGame) print *, "--- starting new game ---" ! initialize the random number generator if (.not. prngReady) then call RANDOM_SEED prngReady = .true. end if !initialize the score and time score1 = 0 score2 = 0 secondsLeft = gameSeconds ! jump ball call RANDOM_NUMBER(r) if (r < 0.5) then whosBall = 1 else whosBall = 2 end if print '(1X,A,I1,A)', "Player ", whosBall, " wins the tip" lookForShot = .true. !--- pass: just look for another shot --- case (pass) lookForShot = .true. !--- shoot: take that shot --- case (shoot) takeTheShot = .true. !--- gameIsOver: show 'em who won --- case (gameIsOver) print *, "(sound of buzzer)" print '(1X,A,I3)', "Player 1 score: ", score1 print '(1X,A,I3)', "Player 2 score: ", score2 if (score1 > score2) then print *, "Congratulations player 1" else if (score2 > score1) then print *, "Congratulations player 2" else print *, "Overtime!" secondsLeft = overTimeSeconds pendingCommand = noCommand end if end select !---------- ! do the simulation !---------- ! take a shot, if we're supposed to if (takeTheShot) then ! see if the shot is made call RANDOM_NUMBER(r) if (r < shotChance) then ! shot was made, count it on the score board print *, "Nice shot" if (whosBall == 1) then score1 = score1 + 2 else score2 = score2 + 2 end if whosBall = 3 - whosBall ! give ball to other player else ! shot was missed print *, "What a brick!" ! see if shooter gets own rebound call RANDOM_NUMBER(r) if (r < reboundChance) then print *, "But you got your own rebound" else whosBall = 3 - whosBall ! give ball to other player end if end if ! look for the next shot lookForShot = .true. end if ! pass the ball around until someone has an open shot do while (lookForShot) ! run some time off the clock call RANDOM_NUMBER(r) secondsLeft = secondsLeft - INT(12 + 33*r) if (secondsLeft <= 0) exit ! see if the ball was stolen call RANDOM_NUMBER(r) if (r < stealChance) then whosBall = 3 - whosBall ! give ball to other player print '(1X,A,I1,A)', "Player ", whosBall, " steals the ball" cycle ! go try for an open shot for this player end if ! figure out chance of making this shot call RANDOM_NUMBER(shotChance) lookForShot = .false. end do end do ! (end of the fetch-command/perform-command loop) print *, "OK, be that way. See if I care." end program hoops1977