checkergame.bak

#lang typed/racket
(require "../include/cs151-core.rkt")
(require "../include/cs151-universe.rkt")
(require "../include/cs151-image.rkt")
(require typed/test-engine/racket-tests)

;; 

;;;;; data definitions 
(define-type Color (U 'red 'black))

(define-struct Loc
  ([row : Integer]
   [col : Integer]))

(define-struct Piece
  ([color : Color]
   [loc : Loc]))

(define-struct Checkers
  ([pieces : (Listof Piece)]
   [turn : Color]
   [clicked-piece : (U 'none Piece)])) 
(: pieces-in-row : Integer Color Integer -> (Listof Piece))
;; Output a list of 4 pieces of the given color in the given row
;; This is a helper function to define starting-board
(define (pieces-in-row row c offset)
  (list
   (Piece c (Loc row (+ 1 offset)))
   (Piece c (Loc row (+ 3 offset)))
   (Piece c (Loc row (+ 5 offset)))
   (Piece c (Loc row (+ 7 offset)))))

(: starting-pieces : (Listof Piece))
(define starting-pieces
  (append
   (pieces-in-row 1 'red 1)
   (pieces-in-row 2 'red 0)
   (pieces-in-row 3 'red 1)
   (pieces-in-row 6 'black 0)
   (pieces-in-row 7 'black 1)
   (pieces-in-row 8 'black 0)))


(: starting-board : Checkers)
(define starting-board (Checkers starting-pieces 'red 'none))


;;;;; creating a piece



(: add-piece : Checkers Color Loc -> Checkers)
;; add a piece to the board at the given location
(define (add-piece game-state c loc)
  (match game-state
    [(Checkers pieces turn clicked-piece)
     (Checkers (cons (Piece c loc) pieces) turn clicked-piece)]))

(: xy->loc : Integer Integer -> Loc)
;; convert (x, y) coordinates to a grid location
(define (xy->loc x y)
  (Loc (+ 1 (exact-floor (/ y 50))) (+ 1 (exact-floor (/ x 50)))))




( : Piece=? : Piece Piece -> Boolean)
;; This function checks if both pieces are the same
(define (Piece=? p1 p2)
  (if (not (or (Piece? p1) (Piece? p2))) (error "both should be pieces")
       (and (symbol=? (Piece-color p1) (Piece-color p2)) (loc=? (Piece-loc p1) (Piece-loc p2)))))

( : click-piece : Piece Checkers -> Checkers)
;; this function takes a grid location and moves
;; a piece into the clicked-piece field
(define (click-piece piece checker)
  (local
    {
     ( : sift : (Listof Piece))
         (define sift (filter
                       (lambda ([p : Piece])
                         (not (Piece=? p piece)))
           (Checkers-pieces checker)))}
    (Checkers sift (Checkers-turn checker) piece)))


( : jump? : Loc Loc -> Boolean)
;; determines whether or not a move is a jump
(define  (jump? loc-one loc-two)
(and
(= (abs (- (Loc-row loc-one) (Loc-row loc-two))) 2)
(= (abs (- (Loc-col loc-one) (Loc-col loc-two))) 2)))

(: between : Loc Loc -> Loc)
;; get the location in between two locations
(define (between loc-one loc-two)
(Loc (quotient (+ (Loc-row loc-one) (Loc-row loc-two)) 2)
(quotient (+ (Loc-col loc-one) (Loc-col loc-two)) 2)))

( : flip : Color -> Color)
;; This function flips the color
(define (flip c)
  (match c
    ['black 'red]
    ['red 'black]))
( : place-piece : Loc Checkers -> Checkers)
;; This function takes in a location and a clicked-piece
;; and puts the clicked piece in that location
(define (place-piece loc game)
   (match game
     [(Checkers pieces turn (Piece c cur-loc))
(Checkers (cons (Piece c loc)
(if (jump? loc cur-loc)
(local{(define loc-to-delete (between loc cur-loc))}
(filter (lambda ([p : Piece])
(not(loc=? (Piece-loc p) loc-to-delete)))
pieces))
pieces))
(flip turn)
'none)]
[(Checkers _ _ 'none) (error "place-piece: no piece to place")]))


 
( : valid-move? : Checkers Loc -> Boolean)
;; This function takes in a checkers game and a
;; location and ouputs whether or not the click-piece can move
;; to the given location.
(define (valid-move? game loc)
  (match* (game loc)
    [((Checkers pieces turn (Piece color (Loc cur-r cur-c))) (Loc r c))
     (and (symbol=? turn color)
          (local
            {
             ( : sign : Integer)
             (define sign (if (symbol=? color 'red) 1 -1))
             ( : move-sign : Integer)
             (define move-sign (if (>= c cur-c) 1 -1))
             ( : one-away : (U 'none Piece))
             (define one-away
               (get-piece-or-none
                (Loc (+ cur-r (* sign 1))
                     (+ cur-c (* move-sign 1)))
                game))
             (: two-away : (U 'none Piece))
             (define two-away (get-piece-or-none (Loc (+ cur-r (* sign 2))
                                                      (+ cur-c (* move-sign 2))) game))
             (: one-valid : Loc)
             (define one-valid (Loc (+ cur-r (* sign 1))
                                    (+ cur-c (* move-sign 1))))
               ( : two-valid : Loc)
               (define two-valid
                 (Loc (+ cur-r (* sign 2))
                      (+ cur-c (* move-sign 2))))
               }
            (or (and (loc=? (Loc r c) one-valid) (symbol? one-away))
                (and (loc=? (Loc r c) two-valid) (symbol? two-away)))))]))
                 
(: click-board : Checkers Integer Integer Mouse-Event -> Checkers)
;; this function is called whenever the mouse does something
;; Currently, it adds a piece to the board at the clicked location
(define (click-board game x y event)
(match event
["button-up" (match (Checkers-clicked-piece game)
[(Piece _ _) (if (valid-move? game (xy->loc x y))
(place-piece (xy->loc x y) game)
game)]
['none (match (get-piece-or-none (xy->loc x y) game)
[(Piece c loc)
(if (symbol=? c (Checkers-turn game))
(click-piece (Piece c loc) game)
game)]
['none game])])]
[_ game])) 
     
  



( : loc=? : Loc Loc -> Boolean)
;; This function takes in two locations and determines whether or
;; not they are same
(define (loc=? loc1 loc2)
  (and (= (Loc-row loc1) (Loc-row loc2))
       (= (Loc-col loc1) (Loc-col loc2))))

( : get-piece-or-none : Loc Checkers -> (U 'none Piece))
;; This function takes in a location and a Checkers
;; and returns a Piece if there is a piece at the location
;; or it returns none if there is no piece there
(define (get-piece-or-none loc checker)
  (local
    {
     ( : pieces-from-list : (Listof Piece))
     (define pieces-from-list
       (filter (lambda ([piece : Piece])
                 (loc=? (Piece-loc piece)
                        loc))
               (Checkers-pieces checker)))}
    (if (= (length pieces-from-list) 0)
        'none
        (first pieces-from-list))))
;; Problem 3
( : red? : Piece -> Boolean)
;; outputs true if red
(define (red? c)
  (cond
    ['red #t]
    ['black #f]))
( : black? : Piece -> Boolean)
;; outputs true if red
(define (black? c)
  (cond
    ['black #t]
    ['true #f]))

( : count-color : (Listof Piece) Color -> Integer)
;; counts the number of pieces of specific color
(define (count-color list c)
  (match c
    ['red (length (filter red? list))]
    ['black (length (filter black? list))]))
      

( : game-over? : Checkers -> Boolean)
;; this function determines whether or not the game is over
(define (game-over? game)
  (and (symbol? (Checkers-clicked-piece game))
       (or
        (= 0(count-color (Checkers-pieces game) 'red))
       (= 0 (count-color (Checkers-pieces game) 'black)))))


;;; ==== Code for interactivity ====
;; Code past this point is used for rendering the game board

;;;;; functions we need from Lab 1
(: draw-square : Integer Image-Color -> Image)
(define (draw-square size color)
  (overlay
   (square size "outline" "black")
   (square size "solid" color)))

(: alt-shaded-row : Integer Integer Image-Color Image-Color -> Image)
(define (alt-shaded-row n size color-one color-two)
  (cond
    [(= 0 n) empty-image]
    [else (beside
           (draw-square size color-one)
           (alt-shaded-row (- n 1) size color-two color-one))]))

(: alt-shaded-rows : Integer Integer Integer Image-Color Image-Color -> Image)
(define (alt-shaded-rows m n size color-one color-two)
  (cond
    [(= 0 m) empty-image]
    [else (above
           (alt-shaded-row n size color-one color-two)
           (alt-shaded-rows (- m 1) n size color-two color-one))]))

(: draw-board : Checkers -> Image)
;; draws the given game state
(define (draw-board game)
  (local
    {(: sq-len : Integer)
     (define sq-len 50)

     (: color-one : Image-Color)
     (define color-one "maroon")
     (: color-two : Image-Color)
     (define color-two "ivory")
     
     (: board : Image)
     (define board (alt-shaded-rows 8 8 sq-len color-one color-two))
     
     (: draw-piece : Color -> Image)
     (define (draw-piece color)
       (circle (round (/ (- sq-len 10) 2))
               "solid"
               (match color
                 ['red  "red"]
                 ['black "black"])))

     (: draw-pieces : (Listof Piece) Image -> Image)
     (define (draw-pieces pieces background)
       (match pieces
         ['() background]
         [(cons (Piece color (Loc r c)) rest)
          (overlay/xy (draw-piece color)
                      (- (* -1 sq-len (- c 1)) 5)
                      (- (* -1 sq-len (- r 1)) 5)
                      (draw-pieces rest background))]))

    
(: draw-clicked-piece : Image -> Image)
     (define (draw-clicked-piece background)
       (match (Checkers-clicked-piece game)
         [(Piece color (Loc r c))
          (overlay/xy (overlay (draw-piece color)
                               (circle (- (/ sq-len 2) 3)
                                       "solid"
                                       (if (= (remainder (+ r c) 2) 0) color-one color-two))
                               (circle (- (/ sq-len 2) 1) "solid" "green"))
                      (- (* -1 sq-len (- c 1)) 1)
                      (- (* -1 sq-len (- r 1)) 1)
                      background)]
         ['none background]))}
    (draw-clicked-piece (draw-pieces (Checkers-pieces game) board))))

(: start-game : -> Checkers)
;; renders an interactive game board in the start state
;; the clauses inside [] below are the handlers for different interactions
;; To draw the game state, we call the function draw-board
;; On a mouse action, we call the function click-board
(define (start-game)
  (big-bang starting-board : Checkers
    [to-draw draw-board]
    [on-mouse click-board]
    [stop-when game-over?]))