(require 2htdp/image)
(require 2htdp/universe)

;; -----------------------------------------------------------------------------
;; A Photo is a (make-photo Image String)
(define-struct photo (img caption))

;; A LOP is one of:
;; - empty
;; - (cons Photo LOP)

(define-struct viewer (current photos))
;; A PV (photo viewer) is (make-viewer Integer LOP)
;; interp: current represents which photo is the current one in photos
;; current must be between 0 and length of photos.

;; -----------------------------------------------------------------------------
(define WIDTH 200)
(define HEIGHT 200)

;; Example data
(define a-photo
  (make-photo (circle 50 "solid" "red") "Red balloon"))

(define b-photo
  (make-photo (square 50 "solid" "blue") "Blue square"))

(define c-photo
  (make-photo (square 50 "outline" "orange") "Not Red"))

(define a-roll
  (list a-photo b-photo))

(define b-roll
  (list a-photo b-photo c-photo))

(define a-pv
  (make-viewer 0 a-roll))

(define b-pv
  (make-viewer 1 a-roll))

;; -----------------------------------------------------------------------------
;; LOP -> PV
;; View given list of photos
(define (main lop)
  (big-bang (make-viewer 0 lop)
            [on-key handle-key-event]
            [to-draw render-viewer]))

;; -----------------------------------------------------------------------------
;; handle-key-event : PV Key -> PV
;; Handle user keyboard input
(check-expect (handle-key-event a-pv "left")
              (move-left a-pv))
(check-expect (handle-key-event a-pv "right")
              (move-right a-pv))
(check-expect (handle-key-event a-pv " ") a-pv)

(define (handle-key-event pv key)
  (cond [(key=? key "left") (move-left pv)]
        [(key=? key "right") (move-right pv)]
        [else pv]))

;; move-left : PV -> PV
;; Advance photo viewer to the left
(check-expect (move-left (make-viewer 0 a-roll))
              (make-viewer 1 a-roll))
(check-expect (move-left (make-viewer 1 a-roll))
              (make-viewer 0 a-roll))
(define (move-left pv)
  (make-viewer (if (zero? (viewer-current pv))
                   (last-index pv)
                   (sub1 (viewer-current pv)))
               (viewer-photos pv)))

;; move-right : PV -> PV
;; Advance photo viewer to the right
(check-expect (move-right (make-viewer 0 a-roll))
              (make-viewer 1 a-roll))
(check-expect (move-right (make-viewer 1 a-roll))
              (make-viewer 0 a-roll))
(check-expect (move-right (make-viewer 0 b-roll))
              (make-viewer 1 b-roll))

(define (move-right pv) 
  (make-viewer (if (= (last-index pv) (viewer-current pv))
                   0
                   (add1 (viewer-current pv)))
               (viewer-photos pv)))

;; last-index : PV -> Natural
(check-expect (last-index a-pv) 1)
(define (last-index pv)
  (sub1 (length (viewer-photos pv))))

;; -----------------------------------------------------------------------------
;; render-viewer : PV -> Scene
;; Render current photo
(check-expect (render-viewer (make-viewer 0 a-roll))
              (place-image (render-photo a-photo)
                           (quotient WIDTH 2)
                           (quotient HEIGHT 2)
                           (empty-scene WIDTH HEIGHT)))
(check-expect (render-viewer (make-viewer 1 a-roll))
              (place-image (render-photo b-photo)
                           (quotient WIDTH 2)
                           (quotient HEIGHT 2)
                           (empty-scene WIDTH HEIGHT)))

(define (render-viewer pv)
  (place-image (render-photo (get-current pv))
               (quotient WIDTH 2)
               (quotient HEIGHT 2)
               (empty-scene WIDTH HEIGHT)))

;; render-photo : Photo -> Image
;; Render photo w/ caption
(check-expect (render-photo a-photo)
              (above (text (photo-caption a-photo) 30 "black")
                     (photo-img a-photo)))
(define (render-photo p)
  (above (text (photo-caption p) 30 "black")
         (photo-img p)))
  
;; PV -> Photo
;; Gets the current photo from given viewer
(check-expect (get-current (make-viewer 0 a-roll)) a-photo)
(define (get-current pv)
  (list-ref (viewer-photos pv) (viewer-current pv)))