;; 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 nat nat list-of-columns)
(define-struct board (width height columns))

;; A column is a list-of-pieces

;; A piece is a string["red" or "black"]

;; ----------------------------------------
;; 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 2 2 (list empty empty)))
              (above (beside empty-space empty-space)
                     (beside empty-space empty-space)))
(check-expect (draw-board (make-board 2 2 (list (list "black") empty)))
              (above (beside empty-space empty-space)
                     (beside black-space empty-space)))
(check-expect (draw-board (make-board 2 2 (list empty (list "red" "black"))))
              (above (beside empty-space red-space)
                     (beside empty-space black-space)))
(check-expect (draw-board (make-board 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 (board-width b)
              (board-height b)
              (add-piece-to-columns (board-columns b)
                                    p
                                    pos)))

;; 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 2 2 (list empty empty))
                         0)
              (make-board 2 2 (list (list "red") empty)))
(check-expect (add-piece "black"
                         (make-board 3 2 (list empty (list "red") empty))
                         1)
              (make-board 3 2 (list empty (list "black" "red") empty)))