;; 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 battleship) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #t #t none #f ())))
(require 2htdp/image)

;; A home-view is a list-of-boat
;;   where the boats do not overlap

;; A boat is a list-of-peg
;;  where the pegs are adjacent and in a row/column

;; A hpeg is
;;   (make-hpeg posn boolean)
;; where posn is on the board, indexing from 0
;; and the boolean is untouched (false) or hit (true)
(define-struct hpeg (loc hit?))

;; An away-view is a list-of-apeg

;; An apeg is
;;   (make-apeg posn boolean)
;; where posn is on the board, indexing from 0
;; and the boolean is miss (false) or hit (true)
(define-struct apeg (loc hit?))

;; A board is 
;;  (make-board away-view home-view)
(define-struct board (away home))

(define COLS 10)
(define ROWS 10)

(define boat-2 (list (make-hpeg (make-posn 5 6) #t)
                     (make-hpeg (make-posn 5 7) #f)))
(define boat-3 (list (make-hpeg (make-posn 0 0) #f)
                     (make-hpeg (make-posn 1 0) #f)
                     (make-hpeg (make-posn 2 0) #f)))
(define boat-3-after-hit (list (make-hpeg (make-posn 0 0) #f)
                               (make-hpeg (make-posn 1 0) #f)
                               (make-hpeg (make-posn 2 0) #t)))

(define home-view-1 (list boat-2 boat-3))

(define away-view-1 (list (make-apeg (make-posn 0 0) #f)
                          (make-apeg (make-posn 0 1) #f)
                          (make-apeg (make-posn 0 2) #t)))

(define board-1 (make-board away-view-1 home-view-1))

;; A response is either
;;   - 'miss
;;   - 'hit
;;   - number (how big the boat was)

;; Todo:
;;   GUI .... board -> scene
;;   board generation...   list-of-num -> board
;;   opponent-hits? : posn board -> response
;;   computer player ....

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

(define CELL-SIZE 16)
(define gray-peg (circle (/ CELL-SIZE 3)  "solid" "gray"))
(define plain-cell (overlay gray-peg
                            (rectangle CELL-SIZE CELL-SIZE  "solid" "blue")))
(define red-peg (circle (/ CELL-SIZE 3)  "solid" "red"))
(define white-peg (circle (/ CELL-SIZE 3)  "solid" "white"))
(define boat-cell (rectangle CELL-SIZE CELL-SIZE  "solid" "gray"))

(define transparent-view (rectangle (* COLS CELL-SIZE) (* ROWS CELL-SIZE)  "outline" "blue"))

(define plain-view
  (n-copies ROWS
            above
            (n-copies COLS beside plain-cell)))

;; draw-posn : posn image -> image
;;  To put the image i at the right relative location
;;  in the result image
(define (draw-posn p i)
  (overlay/xy i
              (- (* CELL-SIZE (posn-x p)))
              (- (* CELL-SIZE (posn-y p)))
              transparent-view))

;; draw-apeg : apeg -> image
(define (draw-apeg a)
  (draw-posn (apeg-loc a)
             (overlay
              (if (apeg-hit? a) red-peg white-peg)
              plain-cell)))

;; draw-hpeg : hpeg -> image
(define (draw-hpeg a)
  (draw-posn (hpeg-loc a)
             (overlay
              (if (hpeg-hit? a) red-peg gray-peg)
              plain-cell)))

;; draw-list : list-of-X image (X -> image) -> image
(define (draw-list draw-elem base-view a)
  (cond
    [(empty? a) base-view]
    [(cons? a) (overlay (draw-elem (first a))  
                        (draw-list draw-elem base-view (rest a)))]))

;; draw-away : away-view -> image
(define (draw-away a)
  (draw-list draw-apeg plain-view a))

;; old-draw-boat : boat -> image
(define (old-draw-boat b)
  (draw-list draw-hpeg transparent-view b))

;; last : non-empty-list-of-X -> X
(define (last l)
  (cond
    [(empty? (rest l)) (first l)]
    [else (last (rest l))]))

;; draw-boat : boat -> image
(define (draw-boat b)
  (overlay
   (local [(define start (first b))
           (define end (last b))
           (define s-posn (hpeg-loc start))
           (define e-posn (hpeg-loc end))]
     (draw-posn s-posn
                (rectangle (* CELL-SIZE (+ 1 (- (posn-x e-posn) (posn-x s-posn))))
                           (* CELL-SIZE (+ 1 (- (posn-y e-posn) (posn-y s-posn))))
                           "outline"
                           "white")))
   (old-draw-boat b)))

;; draw-home : home-view -> image
(define (draw-home h)
  (draw-list draw-boat plain-view h))

;; draw-board : board -> image
(define (draw-board b)
  (above (draw-away (board-away b)) 
         (rectangle 10 10 "solid" "white")
         (draw-home (board-home b))))

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

;; combine-resp : response resposne -> response
(define (combine-resp a b)
  (cond
    [(eq? a 'miss) b]    
    [(eq? a 'hit) 'hit]
    [(number? a) a]))

;; opponent-hits-boat : posn list-of-hpeg -> response
(define (opponent-hits-boat p b)
  (cond
    [(empty? b) 'miss]
    [(cons? b) (local ([define a-hit? (equal? p (hpeg-loc (first b)))]
                       [define b-resp (opponent-hits-boat p (rest b))])
                 (cond
                   [(not a-hit?) (if (number? b-resp)
                                     (if (hpeg-hit? (first b))
                                         (add1 b-resp)
                                         'hit)
                                     b-resp)]
                   [a-hit? (if (andmap hpeg-hit? (rest b))
                               (length b)
                               'hit)]))]))

(check-expect (opponent-hits-boat (make-posn 0 0) empty)
              'miss)
(check-expect (opponent-hits-boat (make-posn 0 0) boat-2)
              'miss)
(check-expect (opponent-hits-boat (make-posn 0 0) boat-3)
              'hit)
(check-expect (opponent-hits-boat (make-posn 5 7) boat-2)
              2)

;; opponent-hits-any-boat : posn list-of-boat -> response
(define (opponent-hits-any-boat p h)
  (cond
    [(empty? h) 'miss]
    [(cons? h) (combine-resp
                (opponent-hits-boat p (first h))
                (opponent-hits-any-boat p (rest h)))]))


(check-expect (opponent-hits-any-boat (make-posn 0 0) (list boat-2))
              'miss)
(check-expect (opponent-hits-any-boat (make-posn 0 0) (list boat-2 boat-3))
              'hit)
(check-expect (opponent-hits-any-boat (make-posn 5 7) (list boat-2))
              2)
(check-expect (opponent-hits-any-boat (make-posn 5 7) (list boat-2 boat-3))
              2)

;; opponent-hits : posn board -> response
(define (opponent-hits p b)
  (opponent-hits-any-boat p (board-home b)))

(check-expect (opponent-hits (make-posn 4 0)
                              board-1)
              'miss)
(check-expect (opponent-hits (make-posn 2 0)
                              board-1)
              'hit)
(check-expect (opponent-hits (make-posn 5 7)
                              board-1)
              2)

;; opponent-update-hpeg : posn hpeg -> hpeg
(define (opponent-update-hpeg p hp)
  (make-hpeg (hpeg-loc hp)
             (or (equal? p (hpeg-loc hp)) 
                 (hpeg-hit? hp))))

(check-expect (opponent-update-hpeg (make-posn 1 2)
                                    (make-hpeg (make-posn 1 2) #f))
              (make-hpeg (make-posn 1 2) #t))
(check-expect (opponent-update-hpeg (make-posn 1 2)
                                    (make-hpeg (make-posn 2 1) #f))
              (make-hpeg (make-posn 2 1) #f))
(check-expect (opponent-update-hpeg (make-posn 1 2)
                                    (make-hpeg (make-posn 2 1) #t))
              (make-hpeg (make-posn 2 1) #t))

;; opponent-update-boat : posn list-of-hpeg -> list-of-hpeg
(define (opponent-update-boat p lohp)
  (map (lambda (hp) (opponent-update-hpeg p hp))
       lohp))

;; opponent-update-all-boats : posn list-of-boat -> list-of-boat
(define (opponent-update-all-boats p lob)
  (map (lambda (b) (opponent-update-boat p b))
       lob))

;; opponent-update : posn board -> board
(define (opponent-update p b)
  (make-board
   (board-away b)
   (opponent-update-all-boats p (board-home b))))
   
(check-expect (opponent-update (make-posn 4 0) board-1)
              board-1)
(check-expect (opponent-update (make-posn 2 0) board-1)
              (make-board away-view-1
                          (list boat-2
                                boat-3-after-hit)))

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

(draw-board board-1)