#lang racket
(require 2htdp/universe 2htdp/image "engine.rkt" "robot.rkt" "config.rkt")
(provide sprite-left sprite-right sprite-up sprite-down search-sprite
sprite-x sprite-y sprite-dx sprite-dy sprite-energy
go-left go-right go-up go-down drop-bomb
bomb? fire? player? robot? blocked?
player robot
run)
(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)))])))]
[move-robot (world-move-robot w)])
(make-world (move-robot (tic-tac (world-decor w)))
(world-move-robot w))))
(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)))
(define (keypress w s)
(let ([j (player (world-decor w))])
(if (empty? j) w
(cond
[(string=? s "up") (make-world (go-up j (world-decor w)) (world-move-robot w))]
[(string=? s "down") (make-world (go-down j (world-decor w)) (world-move-robot w))]
[(string=? s "left") (make-world (go-left j (world-decor w)) (world-move-robot w))]
[(string=? s "right") (make-world (go-right j (world-decor w)) (world-move-robot w))]
[(string=? s " ") (make-world (drop-bomb j (world-decor w)) (world-move-robot w))]
[else w]))))
(define (initial-world move-robot)
(make-world (make-decor (make-decor (new-robot (new-player BORDER))
50
IMAGE-ROCK #f 'rock 0)
100
IMAGE-BRICK #f 'brick 0)
move-robot))
(define (run [move-robot move-robot-default])
(big-bang (initial-world move-robot)
(on-tick tick 0.1)
(to-draw render)
(on-key keypress)))