#lang racket
(require 2htdp/image "config.rkt" racket/gui/base)
(provide (all-defined-out))
(define-struct sprite (x y dx dy image type energy))
(define-struct world (decor move-robot move-player score-player score-robot with-sound))
(define IMAGE-BACKGROUND
(let ([column (apply above (make-list (quotient HEIGHT DELTA) IMAGE-GRASS))])
(apply beside (make-list (quotient WIDTH DELTA) column))))
(define (new-player d)
(make-decor d 1 IMAGE-EMPTY #t 'player ENERGY-PLAYER))
(define (new-robot d)
(make-decor d 1 IMAGE-EMPTY #t 'robot ENERGY-ROBOT))
(define (image-fire f d)
(let ([dx (sprite-dx f)]
[dy (sprite-dy f)])
(cond
[(and (not (= dx 0)) (= dy 0) (empty? (sprite-left f fire? d)))
(bitmap "medias/fire-h-l.png")]
[(and (not (= dx 0)) (= dy 0) (empty? (sprite-right f fire? d)))
(bitmap "medias/fire-h-r.png")]
[(and (= dx 0) (not (= dy 0)) (empty? (sprite-up f fire? d)))
(bitmap "medias/fire-v-u.png")]
[(and (= dx 0) (not (= 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 (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 (sprite-random d dx dy image type energy)
(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 dx dy image type energy)
(sprite-random d dx dy image type energy))))
(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))) (make-decor d (if force n (- n 1)) image force type energy) (make-decor (cons sprite-random d) (- n 1) image force type energy)))))
(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)
(if (energy0? j)
(cons (make-sprite (sprite-x j) (sprite-y j) 0 0 (first IMAGES-BOMB) 'bomb ENERGY-BOMB) d)
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)) (list
(consume s)
(next (+ (sprite-x s) DELTA) (sprite-y s) 1 0) (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 [(> (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 w)
(if (explosion? b d)
(begin
(if (world-with-sound w) (play-sound "medias/explode.wav" true) #t)
(make-sprite (sprite-x b) (sprite-y b)
1 1 (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))))
(define (tic-tac-player-or-robot s d image energie)
(if (energy0? s)
(make-sprite (sprite-x s) (sprite-y s) (sprite-dx s) (sprite-dy s) image (sprite-type s) 0)
(make-sprite (sprite-x s) (sprite-y s) (sprite-dx s) (sprite-dy s)
(if (> (sprite-energy s) (/ energie 2))
IMAGE-EMPTY (if (equal? (sprite-image s) image) IMAGE-EMPTY
image))
(sprite-type s)
(- (sprite-energy s) 1))))