;;; MADE BY GARY KATSEVMAN
;;; licensed under "Creative Commons Attribution-Noncommercial-Share Alike 3.0"
;;; http://creativecommons.org/licenses/by-nc-sa/3.0/us/

;;TETRIS ----------------------------------------------------------------------
;; Data Definitions

;; A Block is a  (make-block Number Number Color)
(define-struct block  (x y color))

;; A Tetra is a  (make-tetra Posn BSet)
;; The center point is the point around which the tetra rotates
;; when it spins.
(define-struct tetra  (center blocks))

;; A Set of Blocks  (BSet) is one of:
;; - empty
;; -  (cons Block BSet)
;; Order does not matter.  Repetitions are NOT allowed.

;; A World is a  (make-world Tetra Tetra BSet number boolean boolean)
;; The BSet represents the pile of blocks at the bottom of the screen.
(define-struct world  (tetra nxt-tetra pile score pause? dead?))

;Constants---------------------------------------------------------------------
(define block-width 20)
(define block-height 20)
(define g-width 200)
(define width 300)
(define height 400)
(define myscene  (empty-scene width height))
(define game-area  (rectangle g-width height 'outline 'black))

;;;ALL THE SEVEN TETRAS--------------------------------------------------------
(define O  (make-tetra
            (make-posn 100 20)
            (list  (make-block 80 0 'green)
                   (make-block 100 0 'green)
                   (make-block 80 20 'green)
                   (make-block 100 20 'green))))
(define OLeft  (make-tetra
                (make-posn 80 20)
                (list  (make-block 60 0 'green)
                       (make-block 80 0 'green)
                       (make-block 60 20 'green)
                       (make-block 80 20 'green))))
(define ORight  (make-tetra
                 (make-posn 120 20)
                 (list  (make-block 100 0 'green)
                        (make-block 120 0 'green)
                        (make-block 100 20 'green)
                        (make-block 120 20 'green))))
(define ORS  (make-tetra
              (make-posn 100 20)
              (list  (make-block 120 0 'green)
                     (make-block 120 20 'green)
                     (make-block 100 0 'green)
                     (make-block 100 20 'green))))
(define ORA  (make-tetra
              (make-posn 100 20)
              (list  (make-block 80 40 'green)
                     (make-block 80 20 'green)
                     (make-block 100 40 'green)
                     (make-block 100 20 'green))))
(define ODown  (make-tetra
                (make-posn 100 40)
                (list  (make-block 80 20 'green)
                       (make-block 100 20 'green)
                       (make-block 80 40 'green)
                       (make-block 100 40 'green))))
(define I  (make-tetra
            (make-posn 90 10)
            (list  (make-block 60 0 'blue)
                   (make-block 80 0 'blue)
                   (make-block 100 0 'blue)
                   (make-block 120 0 'blue))))
(define L  (make-tetra
            (make-posn 110 30)
            (list  (make-block 80 20 'purple)
                   (make-block 100 20 'purple)
                   (make-block 120 0 'purple)
                   (make-block 120 20 'purple))))
(define J  (make-tetra
            (make-posn 90 30)
            (list  (make-block 80 0 'yellow)
                   (make-block 80 20 'yellow)
                   (make-block 100 20 'yellow)
                   (make-block 120 20 'yellow))))
(define T  (make-tetra
            (make-posn 90 30)
            (list  (make-block 80 20 'orange)
                   (make-block 100 0 'orange)
                   (make-block 100 20 'orange)
                   (make-block 120 20 'orange))))
(define Z  (make-tetra
            (make-posn 90 10)
            (list  (make-block 80 0 'pink)
                   (make-block 100 0 'pink)
                   (make-block 100 20 'pink)
                   (make-block 120 20 'pink))))
(define S  (make-tetra
            (make-posn 110 10)
            (list  (make-block 80 20 'red)
                   (make-block 100 0 'red)
                   (make-block 100 20 'red)
                   (make-block 120 0 'red))))



;movement----------------------------------------------------------------------
;next-world : World -> World
;move the world one tick
(define  (next-world w)
  (local [;move-tetra : Tetra -> Tetra
          ;move the tetra down one row
          (define  (move-tetra t)
            (local [ (define tc  (tetra-center t))]
              (make-tetra  (make-posn  (posn-x tc)  (+  (posn-y tc) 
                                                        block-height))
                           (map  (lambda  (b)  (move-block b 0 block-height))
                                 (tetra-blocks t)))))
          (define ntetra  (move-tetra  (world-tetra w)))
          (define tblocks  (tetra-blocks  (world-tetra w)))
          (define ntblocks  (tetra-blocks ntetra))
          (define pile  (remove  (world-pile w)))
          (define nxt-tetra (world-nxt-tetra w))
          (define  (change-score score)
            (let  ([lpile  (length pile)]
                   [lp  (length  (world-pile w))])
              (if  (< lpile lp)
                   (+ score  (* 2  (- lp lpile)))
                   score)))
          (define score  (change-score  (world-score w)))
          (define pause?  (world-pause? w))
          (define dead? (world-dead? w))]
    
    (cond [pause? w]
          [ (tetra-lineup?  (tetra-blocks nxt-tetra) pile)
            (make-world O O empty 0 false true)]
          [ (tetra-lineup? ntblocks pile)
            (make-world nxt-tetra  (next-tetra nxt-tetra) 
                        (append tblocks pile)  (+ score 4) pause? dead?)]
          [ (tetra-on-grid? ntblocks) 
            (make-world ntetra nxt-tetra pile score pause? dead?)]
          [else  (make-world nxt-tetra  (next-tetra nxt-tetra) 
                             (append tblocks pile)  (+ score 4) pause? dead?)])))

;move-world-sideways : World symbol -> World
;given a world and a direction,
;moves the world either left or right
(define  (move-world-sideways w s)
  (local [;move-tetra-sideways : Tetra symbol -> Tetra
          ;move the tetra sideways one step
          (define  (move-tetra-sideways t s)
            (local [ (define tc  (tetra-center t))]
              (if  (symbol=? s 'left)
                   (make-tetra  (make-posn  (-  (posn-x tc) block-width)
                                            (posn-y tc))
                                (map  (lambda  (b) 
                                        (move-block b  (* -1 block-width) 0))
                                      (tetra-blocks t)))
                   (make-tetra  (make-posn  (+  (posn-x tc) block-width)
                                            (posn-y tc))
                                (map  (lambda  (b)
                                        (move-block b block-width 0))
                                      (tetra-blocks t))))))
          (define ntetra  (move-tetra-sideways  (world-tetra w) s))
          (define ntblocks  (tetra-blocks ntetra))
          (define pile  (world-pile w))
          (define nxt-tetra (world-nxt-tetra w))
          (define score  (world-score w))
          (define pause?  (world-pause? w))
          (define dead? (world-dead? w))]
    
    (if  (and  (not  (tetra-lineup? ntblocks pile))
               (tetra-on-grid? ntblocks))
         (make-world ntetra nxt-tetra pile score pause? dead?)
         w)))


;move-block :  Block x-offset y-offset ->Block
;moves block down, left, or right depending on the 
; x-offset and y-offsets
(define  (move-block b x y)
  (make-block  (+  (block-x b) x)
               (+  (block-y b) y)
               (block-color b)))

;;on-key : World KeyEvent -> World
;;given a world and a keyevent and returns the new world
(define  (on-key w key)
  (local [ (define pile  (world-pile w))
           (define nxt-tetra (world-nxt-tetra w))
           (define score  (world-score w))
           (define pause?  (world-pause? w))
           (define dead? (world-dead? w))
           ;rotate-tetra : Tetra Char BSet-> Tetra
           ;rotate the tetra either cw or ccw
           (define  (rotate-tetra t ch pile)
             (local [;block-rotate: op Posn Block->Block
                     ;; Rotate the block 90 degrees clockwise or 
                     ;;counterclockwise around the posn.
                     (define  (block-rotate op c b)
                       (make-block  (op  (posn-x c)
                                         (-  (posn-y c)
                                             (block-y b)))
                                    (op  (posn-y c)
                                         (-  (block-x b)
                                             (posn-x c)))
                                    (block-color b)))
                     (define tc  (tetra-center t))
                     (define tb  (tetra-blocks t))
                     (define  (rotate-all op c b)
                       (if  (empty? b)
                            empty
                            (cons  (op c  (first b))
                                   (rotate-all op c  (rest b)))))
                     (define rotated-Blocks  (if  (char=? ch #\s)
                                                  (rotate-all  (lambda  (c b)
                                                                 (block-rotate 
                                                                  + c b))
                                                               tc tb)
                                                  (rotate-all  (lambda  (c b)
                                                                 (block-rotate 
                                                                  - c b))
                                                               tc tb)))]
               (if  (and  (tetra-on-grid? rotated-Blocks)
                          (not  (tetra-lineup? rotated-Blocks pile)))
                    (make-tetra tc rotated-Blocks)
                    t)))]
    (cond
      [ (char? key)
        (cond
          [ (char=? key #\s) 
            (make-world  (rotate-tetra  (world-tetra w) key pile)
                         nxt-tetra pile score pause? dead?)]
          [ (char=? key #\a) 
            (make-world  (rotate-tetra  (world-tetra w) key pile)
                         nxt-tetra pile score pause? dead?)]
          [ (char=? key #\p) 
            (if (boolean=? true dead?)
                (make-world  (world-tetra w) nxt-tetra
                             pile score  pause? dead?)
                (make-world  (world-tetra w) nxt-tetra
                             pile score  (not pause?) dead?))]
          [ (char=? key #\r)
            (make-world  (next-tetra nxt-tetra)  
                         (next-tetra nxt-tetra) empty 0 false false)]
          [else w])]
      [ (symbol? key)
        (cond 
          [ (symbol=? key 'left)  (move-world-sideways w key)]
          [ (symbol=? key 'right)  (move-world-sideways w key)]
          [ (symbol=? key 'up) 
            (make-world  (rotate-tetra  (world-tetra w) #\s pile)
                         nxt-tetra pile score pause? dead?)]
          [ (symbol=? key 'down)  (next-world w)]
          [else w])]
      [else w])))



;next-tetra : Tetra -> Tetra
;give the next tetra
(define  (next-tetra t)
  (local [ (define r  (+ 1  (random 7)))]
    (cond [ (= r 1) O]
          [ (= r 2) I]
          [ (= r 3) L]
          [ (= r 4) J]
          [ (= r 5) T]
          [ (= r 6) Z]
          [ (= r 7) S])))

;drawing-----------------------------------------------------------------------
;draw-world : World -> Image
;draw the world
(define  (draw-world w)
  (local [ (define score (world-score w))
           (define score-txt (number->string score))
           (define score-img  (text score-txt 16 'blue))
           (define score-img-x 
             (+ g-width (/ (- (- width g-width) (image-width score-img)) 2)))
           (define word-score  (text "Score" 16 'blue))
           (define commands-P-img  (text "P = Pause" 10 'black))
           (define commands-R-img (text "R = Reset" 10 'black))
           (define commands-P-img-x  
             (+ g-width  (/  (-  (- width g-width)  
                                 (image-width commands-P-img)) 2)))
           (define commands-R-img-x  
             (+ g-width  (/  (-  (- width g-width)  
                                 (image-width commands-R-img)) 2)))
           (define word-score-x
             (+ g-width (/ (- (- width g-width) (image-width word-score)) 2)))
           (define nxt-tetra  (world-nxt-tetra w))
           (define nxt-tetra-blocks  (tetra-blocks nxt-tetra))
           ; (define nxt-center (tetra-center nxt-tetra))
           #| (define preview-center (make-posn
                                  (+ 220 (posn-x nxt-center))
                                  (+ 200 (posn-x nxt-center))))|#
           (define preview-blocks  (map make-block 
                                        (map (lambda (b) (+ 150  (block-x b))) 
                                             nxt-tetra-blocks)
                                        (map (lambda (b) (+ 200  (block-y b))) 
                                             nxt-tetra-blocks)
                                        (map (lambda (b) (block-color b))
                                             nxt-tetra-blocks)))
           
           ;draw-block : Block Image -> Image
           ;draw the block
           (define  (draw-block b scene)
             (place-image  (overlay  (rectangle block-width block-height
                                                'solid  (block-color b))
                                     (rectangle block-width block-height
                                                'outline 'black))
                           (+ 10  (block-x b))  (+ 10  (block-y b)) scene))
           ;draw-game-area: Image->Image
           ;adds a rectangle outlining the game area
           (define  (draw-game-area scene)
             (place-image game-area  (/ g-width 2)  (/ height 2) scene))
           ;draw-score: Image->Image
           ;draws the score
           (define  (draw-score scene)
             (place-image word-score word-score-x  (* height .25)
                          (place-image score-img score-img-x (* height .3)
                                       (place-image commands-P-img
                                                    commands-P-img-x 
                                                    (* height .95)
                                                    (place-image
                                                     commands-R-img
                                                     commands-R-img-x
                                                     (* height .90)
                                                     scene)))))
           (define tetra-and-pile (foldl draw-block myscene 
                                         (append (world-pile w)
                                                 (tetra-blocks
                                                  (world-tetra w))
                                                 preview-blocks)))
           (define world-image (draw-score (draw-game-area tetra-and-pile)))
           (define paused-img (text "Paused" 24 'red))
           (define paused-img-x
             (/ (- g-width (image-width paused-img)) 2))
           (define paused-img-y
             (/ (- height (image-height paused-img)) 2))
           (define dead-img (text "GAME OVER!" 22 'red))
           (define dead-img-x
             (/ (- g-width (image-width dead-img)) 2))
           (define dead-img-y
             (/ (- height (image-height dead-img)) 2))]
    (cond [(world-pause? w)
           (place-image paused-img
                        paused-img-x
                        paused-img-y
                        (place-image (rectangle (- g-width 2) (- height 2)
                                                'solid 'white)
                                     (/ g-width 2) (/ height 2) world-image))]
          [(world-dead? w)
           (place-image dead-img
                        dead-img-x
                        dead-img-y
                        (place-image (rectangle (- g-width 2) (- height 2)
                                                'solid 'white)
                                     (/ g-width 2) (/ height 2) world-image))]
           [else world-image]))) 


;removal-----------------------------------------------------------------------
;remove : BSet -> BSet
;given the pile on the bottom, removes all filled lines.
(define  (remove pile)
  (local [(define  (do-stuff pile lon)
            (cond [ (empty? lon) pile]
                  [else  (do-stuff  
                          (remove-line pile (first lon)) (rest lon))]))
          (define (remove-line pile lh)
            (let ([newpile (cond [(<= 10 ((lambda  (lob)
                                            (foldr (lambda (x num) 
                                                     (if (boolean=? x true)
                                                         (+ 1 num)
                                                         num))
                                                   0
                                                   lob))
                                          (map (lambda (b) (= lh (block-y b)))
                                               pile)))
                                  (foldr (lambda (b p) (if (= lh (block-y b))
                                                           p
                                                           (cons b p)))
                                         ' ()
                                         pile)]
                                 [else pile])])
              (if (> (length pile) (length newpile))
                  (remove (map (lambda (b) (if (> lh (block-y b))
                                               (move-block b 0 block-height)
                                               b))
                               newpile))
                  pile)))]
    (do-stuff pile ' (20 40 60 80 100 120 140 160 180 200 220 
                         240 260 280 300 320 340 360 380))))

;collisions--------------------------------------------------------------------
;;tetra-on-grid? BSet -> boolean
;;given the blocks of the tetra, returns false if any of the blocks
;; fall off the screen
(define  (tetra-on-grid? b)
  (if  (empty? b)
       true
       (and   (  ( lambda  (p)  (and  (and  (>=  (posn-x p) 0)
                                            (>=  (- g-width block-width)
                                                 (posn-x p)))
                                      (and  (>=  (posn-y p) 0)
                                            (>=  (- height block-height)
                                                 (posn-y p)))))
                 (let   (  ( fb  (first b)))
                   (make-posn  (block-x fb)
                               (block-y fb))))
              (tetra-on-grid?  (rest b)))))

;tetra-lineup? : BSet BSet -> boolean
;given the BSet of the tetra and the pile on the bottom
;decides whether the tetra will collide with the pile on bottom
(define  (tetra-lineup? t b)
  (local [ (define  (contains? b pile)
             (if  (empty? pile)
                  false
                  (local [ (define bposn  (make-posn 
                                           (block-x b)
                                           (block-y b)))
                           (define fpposn  (make-posn 
                                            (block-x 
                                             (first pile))
                                            (block-y 
                                             (first pile))))]
                    (or   (  ( lambda  (p1 p2)  (and  (=  (posn-x p1) 
                                                          (posn-x p2))
                                                      (=  (posn-y p1)  
                                                          (posn-y p2)))) 
                             bposn fpposn)
                          (contains? b  (rest pile))))))]
    (if  (not  (empty? t))
         (or  (contains?  (first t) b)
              (tetra-lineup?  (rest t) b))
         false)))

(big-bang width height 1/2 
          (make-world  (next-tetra O)  (next-tetra O) empty 0 false false))
(on-tick-event next-world)
(on-key-event on-key)
(on-redraw draw-world)