61 lines
1.8 KiB
Racket
61 lines
1.8 KiB
Racket
#lang racket
|
|
(require 2htdp/universe)
|
|
(require 2htdp/image)
|
|
|
|
(define (initial-forest w p-tree)
|
|
(for/vector #:length w ((rw w))
|
|
(for/vector #:length w ((cl w))
|
|
(if (< (random) p-tree) #\T #\_))))
|
|
|
|
(define (has-burning-neighbour? forest r# c# w)
|
|
;; note, this will check r# c#, too but it's not
|
|
;; worth checking that r=r# and c=c# each time in
|
|
;; this case
|
|
(for*/first
|
|
((r (in-range (- r# 1) (+ r# 2)))
|
|
#:when (< 0 r w)
|
|
(c (in-range (- c# 1) (+ c# 2)))
|
|
#:when (< 0 c w)
|
|
#:when (equal? #\* (vector-ref (vector-ref forest r) c)))
|
|
#t))
|
|
|
|
(define (fire-tick forest p-sprout f-combust w)
|
|
(for/vector #:length w ((rw forest) (r# (in-naturals)))
|
|
(for/vector #:length w ((cl rw) (c# (in-naturals)))
|
|
(case cl
|
|
((#\_) (if (< (random) p-sprout) #\T #\_))
|
|
((#\*) #\_)
|
|
((#\T)
|
|
(cond
|
|
[(has-burning-neighbour? forest r# c# w) #\*]
|
|
[(< (random) f-combust) #\*]
|
|
[else #\T]))))))
|
|
|
|
(define (render-forest state)
|
|
(for/fold
|
|
((scn (empty-scene
|
|
(* (vector-length state) 8)
|
|
(* (vector-length (vector-ref state 0)) 8)
|
|
'black)))
|
|
|
|
((rw state) (r# (in-naturals)))
|
|
(for/fold
|
|
((scn scn))
|
|
((cl rw) (c# (in-naturals)))
|
|
(place-image (circle 4 'solid
|
|
(case cl
|
|
((#\_) 'brown)
|
|
((#\T) 'green)
|
|
((#\*) 'red)))
|
|
(+ 4 (* c# 8)) (+ 4 (* r# 8)) scn))))
|
|
|
|
(define (forest-fire p-tree p-sprout f-combust w)
|
|
(big-bang
|
|
(initial-forest w p-tree) ;; initial state
|
|
[on-tick (lambda (state)
|
|
;(displayln state)
|
|
(fire-tick state p-sprout f-combust w))]
|
|
[to-draw render-forest]))
|
|
|
|
(forest-fire 0 1/8 1/1024 50)
|