#lang racket

; dynablaster by jeeve
; http://augreduvent.limewebs.com

(require 2htdp/universe 2htdp/image racket/gui/base)

(define-struct sprite (x y dx dy image type energy))
(define-struct world (decor))

(define WIDTH 640)
(define HEIGHT 480)
(define DELTA 32)
(define ENERGY-BOMB 10)
(define ENERGY-FIRE 4)

(define IMAGE-GRASS (bitmap "medias/grass.png"))

(define IMAGE-ROCK (bitmap "medias/rock.png"))

(define IMAGE-BRICK (bitmap "medias/brick.png"))

(define (new-player d)
  (make-decor d 1 (bitmap "medias/player.png") #t 'player 0))

(define (new-robot d)
  (make-decor d 1 (bitmap "medias/robot.png") #t 'robot 0))

(define IMAGES-BOMB (list (bitmap "medias/bomb1.png") (bitmap "medias/bomb2.png")))

(define (image-fire f d)
  (let ([dx (sprite-dx f)]
        [dy (sprite-dy f)]) 
    (cond
      [(and (< dx 0) (= dy 0) (empty? (sprite-left f fire? d))) (bitmap "medias/fire-h-l.png")]
      [(and (> dx 0) (= dy 0) (empty? (sprite-right f fire? d))) (bitmap "medias/fire-h-r.png")]
      [(and (= dx 0) (< dy 0) (empty? (sprite-up f fire? d))) (bitmap "medias/fire-v-u.png")]
      [(and (= dx 0) (> dy 0) (empty? (sprite-down f fire? d))) (bitmap "medias/fire-v-d.png")]
      [(and (> (abs dx) 0) (= dy 0)) (bitmap "medias/fire-h.png")]
      [(and (= dx 0) (> (abs dy) 0)) (bitmap "medias/fire-v.png")]
      [else (bitmap "medias/fire-c.png")])))

(define IMAGE-BACKGROUND
  (let ([column (apply above (make-list (quotient HEIGHT DELTA) IMAGE-GRASS))])
    (apply beside (make-list (quotient WIDTH DELTA) column))))

(define (distance s1 s2)
  (let ([x1 (sprite-x s1)]
        [y1 (sprite-y s1)]
        [x2 (sprite-x s2)]
        [y2 (sprite-y s2)])
    (sqrt (+ (sqr (- x2 x1)) (sqr (- y2 y1))))))

(define (bomb? s)
  (equal? (sprite-type s) 'bomb)) 

(define (brick? s)
  (equal? (sprite-type s) 'brick)) 

(define (rock? s)
  (equal? (sprite-type s) 'rock)) 

(define (fire? s)
  (equal? (sprite-type s) 'fire)) 

(define (player? s)
  (equal? (sprite-type s) 'player)) 

(define (robot? s)
  (equal? (sprite-type s) 'robot)) 

(define BORDER
  (flatten (append
            (for/list ([x (in-range 0 (+ WIDTH DELTA) DELTA)])
              (list (make-sprite x 0 0 0 IMAGE-ROCK 'rock 0)
                    (make-sprite x HEIGHT 0 0 IMAGE-ROCK 'rock 0)))
            (for/list ([y (in-range 0 (+ HEIGHT DELTA) DELTA)])
              (list (make-sprite 0 y 0 0 IMAGE-ROCK 'rock 0)
                    (make-sprite WIDTH y 0 0 IMAGE-ROCK 'rock 0))))))

(define (search-sprite x y test decor)
  (let ([distance (lambda (x y s)
                    (let ([x1 (sprite-x s)]
                          [y1 (sprite-y s)])
                      (sqrt (+ (sqr (- x x1)) (sqr (- y y1))))))]) 
    (if (empty? decor)
        '()
        (if (empty? (first decor))
            '()
            (if (and (< (distance x y (first decor)) (/ DELTA 2)) (test (first decor)))
                (first decor)
                (search-sprite x y test (rest decor)))))))

(define (player d)
  (if (empty? d)
      '()
      (if (equal? (sprite-type (first d)) 'player)
          (first d)
          (player (rest d)))))

(define (robot d)
  (if (empty? d)
      '()
      (if (equal? (sprite-type (first d)) 'robot)
          (first d)
          (robot (rest d)))))

(define clone-sprite
  (case-lambda
    [(s) (make-sprite (sprite-x s) (sprite-y s) (sprite-dx s) (sprite-dy s) 
                      (sprite-image s) (sprite-type s) (sprite-energy s))]
    [(s x y) (make-sprite x y (sprite-dx s) (sprite-dy s) (sprite-image s) (sprite-type s) (sprite-energy s))]
    [(s x y dx dy) (make-sprite x y dx dy (sprite-image s) (sprite-type s) (sprite-energy s))]
    [(s x y dx dy e) (make-sprite x y dx dy (sprite-image s) (sprite-type s) e)]))

(define (go-up j d)
  (if (empty? (sprite-up j (lambda (x) #t) d))
      (cons (clone-sprite j (sprite-x j) (- (sprite-y j) DELTA)) 
            (remove j d))
      d))

(define (go-down j d)
  (if (empty? (sprite-down j (lambda (x) #t) d))
      (cons (clone-sprite j (sprite-x j) (+ (sprite-y j) DELTA))
            (remove j d))
      d))

(define (go-left j d)
  (if (empty? (sprite-left j (lambda (x) #t) d))
      (cons (clone-sprite j (- (sprite-x j) DELTA) (sprite-y j)) 
            (remove j d))
      d))

(define (go-right j d)
  (if (empty? (sprite-right j (lambda (x) #t) d))
      (cons (clone-sprite j (+ (sprite-x j) DELTA) (sprite-y j))
            (remove j d))
      d))

(define (explosion? s d)
  (or (= (sprite-energy s) 0)
      (not (empty? (search-sprite (sprite-x s) (sprite-y s) fire? d)))))

(define (energy0? s)
  (<= (sprite-energy s) 0))

(define (energy-max? s)
  (>= (sprite-energy s) ENERGY-FIRE))

(define (sprite-left s type d)
  (search-sprite (- (sprite-x s) DELTA) (sprite-y s) type d))

(define (sprite-right s type d)
  (search-sprite (+ (sprite-x s) DELTA) (sprite-y s) type d))

(define (sprite-up s type d)
  (search-sprite (sprite-x s) (- (sprite-y s) DELTA) type d))

(define (sprite-down s type d)
  (search-sprite (sprite-x s) (+ (sprite-y s) DELTA) type d))

(define (blocked? s d)
  (and (not (empty? (sprite-left s (lambda (x) #t) d)))
       (not (empty? (sprite-right s (lambda (x) #t) d)))
       (not (empty? (sprite-up s (lambda (x) #t) d)))
       (not (empty? (sprite-down s (lambda (x) #t) d)))))

(define (make-decor d n image force type energy)
  (let ([sprite-random (let ([x (* (quotient (random WIDTH) DELTA) DELTA)]
                             [y (* (quotient (random HEIGHT) DELTA) DELTA)])
                         (if (empty? (search-sprite x y (lambda (x) #t) d))
                             (make-sprite x y 0 0 image type energy)
                             '()))])
    (if (= n 0)
        d
        (if (or (empty? sprite-random) 
                (and force (blocked? sprite-random d))) ; player or robot blocked
            (make-decor d (if force n (- n 1)) image force type energy) ; we search an other solution
            (make-decor (cons sprite-random d) (- n 1) image force type energy)))))

(define INITIAL-WORLD
  (make-world (make-decor (make-decor (new-robot (new-player BORDER))
                                      50 
                                      IMAGE-ROCK #f 'rock 0)
                          100
                          IMAGE-BRICK #f 'brick 0)))

(define (consume s)
  (make-sprite (sprite-x s) (sprite-y s) (sprite-dx s) (sprite-dy s)
               (sprite-image s) 
               (sprite-type s)
               (if (> (sprite-energy s) 0) 
                   (- (sprite-energy s) 1)
                   0)))

(define (drop-bomb j d)
  (cons (make-sprite (sprite-x j) (sprite-y j) 0 0 (first IMAGES-BOMB) 'bomb ENERGY-BOMB) d))

(define (spread-fire s d)
  (let ([next (lambda (x y dx dy)
                (if (not (empty? (search-sprite x y brick? d)))
                    (clone-sprite s x y dx dy 0)
                    (if (not (empty? (search-sprite x y rock? d)))
                        '()
                        (clone-sprite s x y dx dy))))])
    (filter (lambda (x) (not (empty? x)))
            (if (and (> (sprite-dx s) 0)
                     (> (sprite-dy s) 0)) ; initial explosion
                (list
                 (consume s)
                 (next (+ (sprite-x s) DELTA) (sprite-y s) 1 0) ; explosion in four directions
                 (next (- (sprite-x s) DELTA) (sprite-y s) -1 0)
                 (next (sprite-x s) (+ (sprite-y s) DELTA) 0 1)
                 (next (sprite-x s) (- (sprite-y s) DELTA) 0 -1))     
                (cond ; explosion in previous direction
                  [(> (sprite-dx s) 0) (list (next (+ (sprite-x s) DELTA) (sprite-y s) (sprite-dx s) 0))]
                  [(< (sprite-dx s) 0) (list (next (- (sprite-x s) DELTA) (sprite-y s) (sprite-dx s) 0))]
                  [(> (sprite-dy s) 0) (list (next (sprite-x s) (+ (sprite-y s) DELTA) 0 (sprite-dy s)))]
                  [(< (sprite-dy s) 0) (list (next (sprite-x s) (- (sprite-y s) DELTA) 0 (sprite-dy s)))])))))

(define (tic-tac-bomb b d)
  (if (explosion? b d)
      (begin
       ; (play-sound "medias/explode.wav" true)
        (make-sprite (sprite-x b) (sprite-y b) 
                     1 1 ; indicates the beginning of the deflagration (horizontal and vertical directions)
                     (image-fire b d)
                     'fire 
                     ENERGY-FIRE))
      (make-sprite (sprite-x b) (sprite-y b) 0 0
                   (if (equal? (sprite-image b) (first IMAGES-BOMB))
                       (last IMAGES-BOMB)
                       (first IMAGES-BOMB))
                   (sprite-type b) 
                   (- (sprite-energy b) 1))))

; intelligent robot
(define (bouge-robot d)
  (let* ([x (random 100)]
         [r (robot d)]
         [danger? (lambda (x) (or (bomb? x) (fire? x)))]
         [something? (lambda (x) #t)]
         [escape (lambda (r d)
                   (cond [(not (empty? (sprite-left r danger? d))) (go-right r d)] 
                         [(not (empty? (sprite-right r danger? d))) (go-left r d)] 
                         [(not (empty? (sprite-up r danger? d))) (go-down r d)]
                         [(not (empty? (sprite-down r danger? d))) (go-up r d)]                      
                         [(not (empty? (search-sprite (sprite-x r) (sprite-y r) bomb? d)))
                          (cond  [(empty? (sprite-left r something? d)) (go-left r d)] 
                                 [(empty? (sprite-right r something? d)) (go-right r d)] 
                                 [(empty? (sprite-up r something? d)) (go-up r d)]
                                 [(empty? (sprite-down r something? d)) (go-down r d)]                     
                                 [else d])]))]) 
    (if (empty? r)
        d
        (cond
          ; fear of fire
          [(or (not (empty? (sprite-left r danger? d))) 
               (not (empty? (sprite-right r danger? d)))
               (not (empty? (search-sprite (sprite-x r) (sprite-y r) bomb? d)))) 
           (if (empty? (sprite-up r something? d))
               (go-up r d)
               (if (empty? (sprite-down r something? d))
                   (go-down r d)
                   (escape r d)))] 
          [(or (not (empty? (sprite-up r danger? d))) 
               (not (empty? (sprite-down r danger? d)))
               (not (empty? (search-sprite (sprite-x r) (sprite-y r) bomb? d))))
           (if (empty? (sprite-left r something? d))
               (go-left r d)
               (if (empty? (sprite-right r something? d))
                   (go-right r d)
                   (escape r d)))]
          ; intention
          [(and (> x 0) (<= x 10) (empty? (sprite-up r fire? d))) (go-up r d)]
          [(and (> x 10) (<= x 20) (empty? (sprite-down r fire? d))) (go-down r d)]
          [(and (> x 20) (<= x 30) (empty? (sprite-left r fire? d))) (go-left r d)]
          [(and (> x 30) (<= x 40) (empty? (sprite-right r fire? d))) (go-right r d)]
          [(and (> x 40) (<= x 42) (not (blocked? r d))) (drop-bomb r d)]
          [else d]))))

; at each clock tick
(define (tick w)
  (letrec ([destruction (lambda (d)
                          (if (empty? (search-sprite (sprite-x (first d)) 
                                                     (sprite-y (first d)) 
                                                     fire? 
                                                     (world-decor w)))
                              (cons (first d) (tic-tac (rest d)))
                              (tic-tac (rest d))))]
           [tic-tac (lambda (d)
                      (if (empty? (rest d))
                          d
                          (cond [(bomb? (first d)) (cons (tic-tac-bomb (first d) d) (tic-tac (rest d)))]
                                [(fire? (first d)) (if (energy0? (first d))
                                                       (tic-tac (rest d))
                                                       (if (or (> (abs (sprite-dx (first d))) 0) 
                                                               (> (abs (sprite-dy (first d))) 0))
                                                           (append (spread-fire (consume (first d)) (world-decor w)) 
                                                                   (tic-tac (rest d)))
                                                           (cons (consume (first d)) (tic-tac (rest d)))))]
                                [(brick? (first d)) (destruction d)]
                                [(player? (first d)) (destruction d)]
                                [(robot? (first d)) (destruction d)]
                                [else (cons (first d) (tic-tac (rest d)))])))])    
    (make-world (bouge-robot (tic-tac (world-decor w))))))

; render
(define (render w)
  (letrec ([place-sprites (lambda (sprites image)
                            (if (empty? sprites)
                                image
                                (place-image (if (fire? (first sprites))
                                                 (image-fire (first sprites)                                     
                                                             (world-decor w))
                                                 (sprite-image (first sprites)))
                                             (sprite-x (first sprites))
                                             (sprite-y (first sprites))
                                             (place-sprites (rest sprites) image))))])           
    (place-sprites (world-decor w) IMAGE-BACKGROUND)))

; keyboard handling
(define (keypress w s)
  (let ([j (player (world-decor w))])    
    (if (empty? j) ; if next player
        w
        (cond
          [(string=? s "up") (make-world (go-up j (world-decor w)))]
          [(string=? s "down") (make-world (go-down j (world-decor w)))]
          [(string=? s "left") (make-world (go-left j (world-decor w)))]
          [(string=? s "right") (make-world (go-right j (world-decor w)))]
          [(string=? s " ") (make-world (drop-bomb j (world-decor w)))]
          [else w]))))

; let's go
(big-bang INITIAL-WORLD
          (on-tick tick 0.1)   
          (to-draw render)
          (on-key keypress))