;; The first three lines of this file were inserted by DrRacket. They record metadata
;; about the language level of this file in a form that our tools can easily process.
#reader(lib "htdp-advanced-reader.ss" "lang")((modname connect-four) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #t #t none #f ())))
(require 2htdp/universe)
(require 2htdp/image)

;; A board is a
;;  (make-board string nat nat list-of-columns)
(define-struct board (turn width height columns))

;; A column is a list-of-pieces

;; A piece is a string["red" or "black" or "blank"]
;; (but the "blank" case isn't used for a board)

;; ----------------------------------------
;; Drawing a board

(define RECT-SIDE 30)
(define CIRC-RADIUS 12)

;; make-space : string -> image
(define (make-space color)
  (overlay (circle CIRC-RADIUS 'solid color)
           (rectangle RECT-SIDE RECT-SIDE 'solid "yellow")))

(define empty-space (make-space "white"))
(define red-space (make-space "red"))
(define black-space (make-space "black"))

;; draw-board : board -> image
(define (draw-board b)
  (draw-columns (board-columns b) (board-height b)))

;; draw-columns : list-of-column nat -> image
(define (draw-columns columns height)
  (cond
    [(empty? columns) empty-image]
    [(cons? columns) 
     (beside (draw-column (first columns) height)
             (draw-columns (rest columns) height))]))

;; draw-column : list-of-piece nat -> image
(define (draw-column col height)
  (draw-upsidedown-column (reverse col) height))

;; draw-upsidedown-column : list-of-piece nat -> image
;;  height is the remaining height of column
(define (draw-upsidedown-column col height)
  (cond
    [(empty? col) (stack-copies empty-space height)]
    [(cons? col) 
     (above (draw-upsidedown-column (rest col) (sub1 height))
            (make-space (first col)))]))

;; stack-copies : image nat -> image
(define (stack-copies i n)
  (cond
    [(zero? n) empty-image]
    [else (above i (stack-copies i (sub1 n)))]))

(check-expect (stack-copies red-space 3)
              (above red-space red-space red-space))

(check-expect (draw-column empty 2)
              (above empty-space empty-space))
(check-expect (draw-column (list "red") 2)
              (above empty-space red-space))
(check-expect (draw-column (list "red" "black") 2)
              (above red-space black-space))

(check-expect (draw-board (make-board "red" 2 2 (list empty empty)))
              (above (beside empty-space empty-space)
                     (beside empty-space empty-space)))
(check-expect (draw-board (make-board "red" 2 2 (list (list "black") empty)))
              (above (beside empty-space empty-space)
                     (beside black-space empty-space)))
(check-expect (draw-board (make-board "red" 2 2 (list empty (list "red" "black"))))
              (above (beside empty-space red-space)
                     (beside empty-space black-space)))
(check-expect (draw-board (make-board "red" 2 4 (list empty (list "red" "black"))))
              (above (beside empty-space empty-space)
                     (beside empty-space empty-space)
                     (beside empty-space red-space)
                     (beside empty-space black-space)))

;; ----------------------------------------
;; Adding a piece

;; add-piece : piece board nat -> board
;;  assume that there's space, and that the column exists
(define (add-piece p b pos)
  (make-board (switch-player (board-turn b))
              (board-width b)
              (board-height b)
              (add-piece-to-columns (board-columns b)
                                    p
                                    pos)))

;; switch-player : string -> string
(define (switch-player s)
  (cond
    [(string=? s "red") "black"]
    [else "red"]))

;; add-piece-to-columns : list-of-column piece nat -> list-of-columns
(define (add-piece-to-columns cols p pos)
  (cond
    [(empty? cols) (error "huh?")]
    [(cons? cols)
     (if (zero? pos)
         (cons (add-piece-to-column (first cols) p)
               (rest cols))
         (cons (first cols)
               (add-piece-to-columns (rest cols) p (sub1 pos))))]))

;; add-piece-to-column : list-of-piece p -> list-of-piece
(define (add-piece-to-column col p)
  (cons p col))

(check-expect (add-piece "red"
                         (make-board "red" 2 2 (list empty empty))
                         0)
              (make-board "black" 2 2 (list (list "red") empty)))
(check-expect (add-piece "black"
                         (make-board "black" 3 2 (list empty (list "red") empty))
                         1)
              (make-board "red" 3 2 (list empty (list "black" "red") empty)))

;; ----------------------------------------

;; column-full? : board nat -> boolean
;;   Assume that n is an ok column number
(define (column-full? b n)
  (= (board-height b) 
     (length (list-ref (board-columns b) n))))

(check-expect (column-full? (make-board "red" 2 2 (list empty empty)) 0)
              false)
(check-expect (column-full? (make-board "red" 2 2 (list (list "red" "black") empty)) 0)
              true)
(check-expect (column-full? (make-board "red" 2 2 (list (list "red" "black") empty)) 1)
              false)
(check-expect (column-full? (make-board "red" 2 3 (list (list "red" "black") empty)) 0)
              false)

;; ----------------------------------------

;; handle-mouse : board num num string -> board
(define (handle-mouse b x y kind)
  (cond
    [(string=? kind "button-down")
     (handle-click b x y)]
    [else b]))

;; handle-click : board num num -> board
(define (handle-click b x y)
  (local [(define col (quotient x RECT-SIDE))]
    (if (column-full? b col)
        b
        (add-piece (board-turn b) b col))))

(define small-empty-board (make-board "red" 2 2 (list empty empty)))

(check-expect (handle-mouse small-empty-board
                            1 2
                            "button-down")
              (add-piece "red" small-empty-board 0))
(check-expect (handle-mouse small-empty-board
                            (+ RECT-SIDE 1) 25
                            "button-down")
              (add-piece "red" small-empty-board 1))
(check-expect (handle-mouse small-empty-board
                            1 2
                            "move")
              small-empty-board)
(check-expect (handle-mouse (make-board "red" 2 2 (list (list "black" "red") empty))
                            1 2
                            "button-down")
              (make-board "red" 2 2 (list (list "black" "red") empty)))

;; ----------------------------------------

;; wins? : board piece -> boolean
(define (wins? b piece)
  (or (wins-in-column? b piece)
      (wins-in-row? b piece)
      (wins-diagonal? b piece)))

;; wins? : board piece -> boolean
(define (wins-in-column? b piece)
  (ormap (lambda (col)
           (wins-in-seq? col piece 0))
         (board-columns b)))

;; wins-in-seq? : list-of-pieces piece num -> boolean
;;  already-seen is the number of consecutive matching
;;  pieces that we've already seen
(define (wins-in-seq? col piece already-seen)
  (cond
    [(empty? col) (= already-seen 4)]
    [else
     (or (= already-seen 4)
         (wins-in-seq? (rest col) 
                       piece 
                       (if (string=? (first col) piece)
                           (add1 already-seen)
                           0)))]))

(check-expect (wins-in-column? small-empty-board "red")
              false)
(check-expect (wins-in-column? small-empty-board "black")
              false)
(check-expect (wins-in-column? (make-board "black" 2 4 (list (list "red" "red" "red" "red") 
                                                             (list "black" "black" "black")))
                               "red")
              true)
(check-expect (wins-in-column? (make-board "red" 3 4 (list 
                                                      (list "red" "red" "red") 
                                                      (list "black" "black" "black" "black")
                                                      (list "red")))
                               "black")
              true)


(define (wins-in-row? b piece)
  (local [(define upsidedown-columns (map reverse (board-columns b)))]
    (wins-in-a-row? upsidedown-columns piece)))

;; wins-in-a-row? : list-of-column piece -> boolean
(define (wins-in-a-row? cols piece)
  (cond
    [(andmap empty? cols) false]
    [else (or (wins-in-seq? (extract-first-row cols) piece 0)
              (wins-in-a-row? (drop-first-row cols) piece))]))

;; extract-first-row : list-of-columns -> list-of-piece
(define (extract-first-row cols)
  (map (lambda (col)
         (cond
           [(empty? col) "blank"]
           [else (first col)]))
       cols))

(check-expect (extract-first-row (list (list "red") empty))
              (list "red" "blank"))
(check-expect (extract-first-row (list (list "red") (list "black" "red")))
              (list "red" "black"))

;; drop-first-row : list-of-columns -> list-of-columns
(define (drop-first-row cols)
  (map (lambda (col)
         (cond
           [(empty? col) empty]
           [else (rest col)]))
       cols))

(check-expect (drop-first-row (list (list "red") empty))
              (list empty empty))
(check-expect (drop-first-row (list (list "red") (list "black" "red")))
              (list empty (list "red")))

(check-expect (wins-in-row? small-empty-board "red")
              false)
(check-expect (wins-in-row? small-empty-board "black")
              false)
(check-expect (wins-in-row? (make-board "black" 4 2 (list (list "black" "red")
                                                          (list "black" "red")
                                                          (list "black" "red")
                                                          (list         "red")))
                            "red")
              true)
(check-expect (wins-in-row? (make-board "red" 4 3 (list (list "red" "black" "red")
                                                        (list "red" "black" "red")
                                                        (list       "black" "red")
                                                        (list       "black" "black")))
                            "black")
              true)

(define (wins-diagonal? b piece)
  false)



;; ----------------------------------------

#;
(big-bang
 (make-board "red" 7 6 (list empty empty empty empty empty empty empty))
 [to-draw draw-board]
 [on-mouse handle-mouse])


;; To do:
;;   - handle mouse clicks
;;   - detect winning states
;;   - computer player