;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; NAME: m1210.scm
;;;
;;; DESCRIPTION: The 1,2,...,10 game
;;;
;;; AUTHORS: Dan Garcia - University of California at Berkeley
;;; Ported to Scheme by Greg Krimer, David Schultz, Alex
;;; Kozlowski, and Alan Sheinberg
;;;
;;; Copyright (C) Dan Garcia, 1995. All rights reserved.
;;;
;;; UPDATE HIST:
;;;
;;; 2001-11-05: (v2.0s) Release for Fall 2001 CS3.
;;; 2003-11-03: (v3.0) Added error checking for changing initial
;;; position, and simple graphics modified to
;;; scale board and pieces.
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;
;;; These tell the library a bit about the game.
;;;;;;;;;
(define *game-name* "1,2,...,10")
(define *group-members* "The Gamesmen")
(name-game-pieces "Left" "Right")
;;;;;;;;;
;;; GET-TURN (helper for whose-move)
;;; Input: position
;;; Output: a turn representation, l or r.
;;; Example: (get-turn '(r 3)) ==> r
;;;;;;;;;
(define (get-turn position)
(first position))
;;;;;;;;;
;;; WHOSE-MOVE ALL GAMES
;;; Input: Position
;;; Output: The piece whose turn it is. Note: The piece names are the
;;; names that are given the function NAME-GAME-PIECES. These
;;; should have quotes (") around them (e.g. "BLUE").
;;; Example: (whose-move '(l 5)) ==> Left
;;;;;;;;;
(define (whose-move pos)
(if (equal? (get-turn pos) 'l)
"Left"
"Right"))
;;;;;;;;;
;;; MAKE-POSITION ALL GAMES
;;; Input: Player, Board
;;; Output: A position
;;; Example: (make-position 'r '(3)) ==> (r 3)
;;;;;;;;;
(define (make-position whose-turn board)
(se whose-turn board))
;;;;;;;;;
;;; MAKE-BOARD ALL GAMES
;;; Input: number of slots filled in the row.
;;; Output: A board
;;; Example: (make-board 3) ==> (3)
;;;;;;;;;
(define (make-board slots-filled) (se slots-filled))
;;;;;;;;;
;;; GET-BOARD ALL GAMES
;;; Input: Position
;;; Output: A board
;;; Example: (get-board '(l 7)) ==> (7)
;;;;;;;;;
(define (get-board position)
(bf position))
;;;;;;;;;
;;; GET-NUM-ROWS ALL GAMES
;;; Input: Position
;;; Output: The number of rows in POSITION (only ever 1 for this game)
;;; Example: (get-num-rows '(5)) ==> 1
;;;;;;;;;
(define (get-num-rows board) 1)
;;;;;;;;;
;;; GET-NUM-COLS ALL GAMES
;;; Input: Position
;;; Output: The number of columns in POSITION (always 10 for this game)
;;; Example: (get-num-cols '(7)) ==> 10
;;;;;;;;;
(define (get-num-cols board) 10)
;;;;;;;;;
;;; GET-FILLED-SLOTS
;;; Input: board
;;; Output: the number of filled slots on the board
;;; Description: additional selector unique to this game.
;;; returns the number of filled slots.
;;; Example: (get-filled-slots '(5)) ==> 5
;;;;;;;;;
(define (get-filled-slots board)
(first board))
;;;;;;;;;
;;; Create the game-specific option menu ALL GAMES
;;;
;;; Menu entries are added with a call to:
;;; (ADD-MENU-ENTRY! printer changer)
;;; The PRINTER is a procedure that displays the menu entry
;;; The CHANGER is a procedure that takes user input (if applicable)
;;; and changes the menu entry.
;;;;;;;;;
;;; DISPLAY-STANDARD-MISERE gets called to display the STANDARD-GAME option
(define (display-standard-misere)
(if (get-rule 'standard-game)
(display "Toggle from [STANDARD] to misere play")
(display "Toggle from [MISERE] to standard play")))
;;; TOGGLE-STANDARD-MISERE gets called to change the STANDARD-GAME option
(define (toggle-standard-misere)
(set-rule! 'standard-game (not (get-rule 'standard-game))))
;;; Add the menu entry
(add-menu-entry! display-standard-misere toggle-standard-misere)
;;; Set the default value
(set-rule! 'standard-game #t)
;;;;;;;;;
;;; Set the starting position
;;;;;;;;;
(set-rule! 'initial-position (make-position 'l (make-board 0)))
;;; CHANGE-INITIAL-POSITION gets called when the user wants to change start pos
(define (change-initial-position)
(input-who-goes-first)
(input-filled-slots) )
;; prompts the user for who goes first.
;; Error checking handled.
(define (input-who-goes-first)
(display "Should l or r go first? ")
(let ((turn (read))
(current-position (get-rule 'initial-position)))
(if (or (equal? turn 'r) (equal? turn 'l))
(set-rule! 'initial-position
(make-position turn
(get-board current-position)))
(begin
(display (word turn " is not valid. The valid inputs are l and r. \n \n"))
(input-who-goes-first)))))
;; prompts the user for the number of filled slots.
;; Error checking handled.
(define (input-filled-slots)
(display "How many slots would you like filled? ")
(let ((filled (read))
(current-position (get-rule 'initial-position))
(current-board (get-board (get-rule 'initial-position))))
(if (and (integer? filled)
(>= filled 0)
(<= filled (get-num-cols current-board)))
(begin
(set-rule! 'initial-position
(make-position (get-turn current-position)
(make-board filled)))
(display "You have successfully changed the initial position. \n \n" )
(display "The initial position had now been set to: ")
(display (get-rule 'initial-position))
)
(begin
(display (word filled " is not valid. \n \n"))
(display "Valid inputs are non-negative integers less than or equal to ")
(display (word (get-num-cols current-board) ".\n \n"))
(input-filled-slots)))))
;;; DISPLAY-INITIAL-POSITION gets called to show the current board.
(define (display-change-initial-position)
(display "Change the initial position, currently: ")
(display (get-rule 'initial-position)))
;;; Add the menu entry
(add-menu-entry! display-change-initial-position change-initial-position)
;;;;;;;;;
;;; PRINT-HELP ALL GAMES
;;; Side-Effect: Prints a useful help message about the current game
;;; given the current options.
;;;;;;;;;
(define (print-help)
(show "THE RULES ARE...")
(newline)
(show "On your turn you must fill the next 1 or 2 slots on the board.\n")
(show "THE OBJECTIVE IS...\n")
(if (get-rule 'standard-game)
(display "To be the player who fills the last slot.\n")
(display "NOT to be the player who fills the last slot.\n")))
;;;;;;;;;
;;; PRINT-POSITION ALL GAMES
;;; Input: Position
;;; Side-Effect: Prints the board pretty
;;; Example: (print-position '(l 2)) ==>
;;;
;;; Game is STANDARD
;;; |||||||
;;; 0 1 2 3 4 5 6 7 8 9 10
;;;;;;;;;
(define (print-position position)
(display "Game is ")
(if (get-rule 'standard-game)
(display "STANDARD")
(display "MISERE"))
(newline)
(display "|")
(print-bars (get-filled-slots (get-board position)))
(newline)
(print-scale 0 (get-num-cols (get-board position)))
(newline))
;;;;;;;;;
;;; PRINT-BARS
;;; Input: Position
;;; Side-Effect: Prints the right number of bars for the position
;;;;;;;;;
(define (print-bars n)
(print-bars-helper n 0))
;; Helper for PRINT-BARS which prints the correct number of bars
;; for the number printed, keeping in mind that 2 digit numbers
;; on the scale take up more space tham one digit numbers.
(define (print-bars-helper total-to-print printed-so-far)
(cond ((= total-to-print printed-so-far)
'done)
((< printed-so-far 10)
(display "|||")
(print-bars-helper total-to-print (+ printed-so-far 1)))
(else
(display "||||")
(print-bars-helper total-to-print (+ printed-so-far 1)))) )
;;;;;;;;;
;;; PRINT-SCALE
;;; Input: Numbers FROM and TO
;;; Requires: FROM & TO be one- or two-digit numbers
;;; Side-Effect: Prints a numerical scale from FROM to TO
;;;;;;;;;
(define (print-scale from to)
(cond ((> from to) 'done)
((= (count from) 1) ;; one-digit #
(display from)
(display " ")
(print-scale (+ from 1) to))
((= (count from) 2) ;; two-digit #
(display from)
(display " ")
(print-scale (+ from 1) to))
(else
(error
(word "print-scale expected a 1- or 2-digit 'from', but was given: "
from)))))
;;;;;;;;;
;;; DO-MOVE ALL GAMES
;;; Input: Position, move (in this order!)
;;; Output: New position that results from the move
;;; Example: (do-move '(l 3) 2) ==> (r 5)
;;;;;;;;;
(define (do-move position move)
(make-position (get-other-player position)
(make-board (+ (get-filled-slots (get-board position))
move))))
;;;;;;;;;
;;; GET-OTHER-PLAYER
;;; Input: position
;;; Output: word, the other player
;;; Example: (get-other-player '(r 3)) => 'l
;;;;;;;;;
(define (get-other-player position)
(if (equal? (get-turn position) 'l) 'r 'l))
;;;;;;;;;
;;; GENERATE-MOVES ALL GAMES
;;; Input: Position
;;; Output: List of all possible moves that can be made from the position by
;;; the piece whose turn it is.
;;; Example 1: (generate-moves '(r 7)) ==> (1 2)
;;; Example 2: (generate-moves '(l 9)) ==> (1)
;;; Example 3: (generate-moves '(r 10)) ==> ()
;;;;;;;;;
(define (generate-moves position)
(let ((board (get-board position)))
(let ((filled (get-filled-slots board))
(max-filled (get-num-cols board)))
(cond
((= filled max-filled)
(list)) ;; the empty list {}
((= (+ filled 1) max-filled)
(list 1)) ;; {1}
(else (list 1 2))) ;; {1,2} -- that's why this is called "1,2,...,10")
) ) )
;;;;;;;;;
;;; PRIMITIVE-POSITION ALL GAMES
;;; Input: Position
;;; Output:
;;; l (for lose) if the previous move puts this player in a loss.
;;; w (for win) if the previous move puts this player in a win.
;;; #f if the game is not yet determined or otherwise
;;; Example 1: (primitive-position '(r 5)) ==> #f
;;; Example 2: (primitive-position '(l 10)) ==> #t
;;;;;;;;;
(define (primitive-position position)
(let ((board (get-board position)))
;; If you think the following line would work here:
;;
;; (if (null? (generate-moves position))
;;
;; ...you're right, BUT generate-moves is a really SLOW function
;; and will make your code very slow indeed. So it's best not to
;; put that here.
(if (= (get-filled-slots board) (get-num-cols board)) ;; filled!
(if (get-rule 'standard-game) 'l 'w)
#f)))
;;;;;;;;;
;;; SIMPLE GRAPHICS
;;;;;;;;;
;;;;;;;;;
;;; INIT-CANVAS ALL GAMES
;;; Input: Position
;;; Side-Effect: Set the size of the canvas to whatever is desired and perform
;;; any other intialization required for graphics.
;;;
;;; This function is called by Gamesman each time SIMPLE graphics is turned on.
;;;;;;;;;
(define (init-canvas pos)
(set-canvas-size (* (get-num-cols (get-board pos)) (get-square-width pos))
(* (get-num-rows (get-board pos)) (get-square-height pos))))
;; sets a constant canvas size so that the you will always be able
;; to see the whole game board on the screen
(define *board-horizontal-max* 1000)
(define *board-vertical-max* 100)
;; the closest number of horizontal pixels that
;; each square can be and not exceed the max size of the canvas.
(define (get-square-width pos)
(quotient *board-horizontal-max* (get-num-cols (get-board pos))))
;; the closest number of vertical pixels that
;; each square can be and not exceed the max size of the canvas.
(define (get-square-height pos)
(quotient *board-vertical-max* (get-num-rows (get-board pos))))
;;;;;;;;;;;;;
;;; DRAW-POSITION ALL GAMES
;;; Input: Position
;;; Side-Effect: Draw the position using the grdraw STk graphics library.
;;;
;;; This is called if Gamesman is in simple-graphics mode.
;;;;;;;;;;;;;
(define (draw-position pos)
(let ((num-rows (get-num-rows (get-board pos)))
(num-cols (get-num-cols (get-board pos))))
(let ((square-height (get-square-height pos))
(square-width (get-square-width pos)))
(let ((board-height (* num-rows square-height))
(board-width (* num-cols square-width)))
;;; The following functions are internal to DRAW-POSITION and have access
;;; to the variables defined in the LET statements above:
;;; 1.draw-piece,
;;; 2.draw-all-pieces
;;; DRAW-PIECE
;;; Input: coordinates x, y
;;; Draws a piece at the given coordinates
(define (draw-piece x y)
(draw-oval (+ x (* .1 square-width))
(+ y (* .1 square-height))
(+ x (* .9 square-width))
(+ y (* .9 square-height)) ;; the two points
'width (quotient square-height 10) ;; thickness of line
'outline "blue" ;; color of O
'fill "blue")) ;; color inside O
;;; DRAW-ALL-PIECES
;;; Input: row, x-cor, y-cor
;;; Side-Effect: draws all the pieces in the filled slots
(define (draw-all-pieces filled-slots x-cor y-cor)
(if (= 0 filled-slots)
#t
(begin
(draw-piece x-cor y-cor)
(draw-all-pieces (- filled-slots 1)
(+ x-cor square-width)
y-cor) ) ) )
;; Beginning of the actual DRAW-POSITION execution.
(clear-graphics!)
(draw-all-pieces (get-filled-slots (get-board pos)) 0 0)
(draw-frame pos)))))
;;;;;;;;;
;;; DRAW-FRAME
;;; Input: position
;;; Side-effect: Draws the framework of vertical and horizontal lines
;;; that delineate the game board.
;;;;;;;;;
(define (draw-frame pos)
(let ((num-rows (get-num-rows (get-board pos)))
(num-cols (get-num-cols (get-board pos))))
(let ((square-height (get-square-height pos))
(square-width (get-square-width pos)))
(let ((board-height (* num-rows square-height))
(board-width (* num-cols square-width )))
;; internal function for drawing vertical lines
(define (draw-vert-lines lines-drawn-so-far)
(let ((x-cor (* lines-drawn-so-far square-width)))
(if (= (+ 1 num-cols) lines-drawn-so-far)
#t ;; done drawing
(begin
(draw-line x-cor 0 x-cor board-height)
(draw-vert-lines (+ 1 lines-drawn-so-far))))))
;; internal function for drawing vertical lines
(define (draw-horiz-lines lines-drawn-so-far)
(let ((y-cor (* lines-drawn-so-far square-height)))
(if (= (+ 1 num-rows) lines-drawn-so-far)
#t ;; done drawing
(begin
(draw-line 0 y-cor board-width y-cor)
(draw-horiz-lines (+ 1 lines-drawn-so-far))))))
;; beginning of DRAW-FRAME execution.
(set-default-fill-color! "black")
(draw-vert-lines 0)
(draw-horiz-lines 0) ) ) ) )