;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; 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) ) ) ) )