Welcome to the CHICKEN Scheme pasting service

(use loop doodle)

(new-doodle width: 800 height: 600)

(define *field-width* 100)
(define *field-height* 80)
(define *terrain-xoffset* 0)
(define *terrain-yoffset* -50)

(define-resource 'water #:image "Water Block.png" *terrain-xoffset* *terrain-yoffset*)
(define-resource 'stone #:image "Stone Block.png" *terrain-xoffset* *terrain-yoffset*)
(define-resource 'princess #:image "Character Princess Girl.png" 0 -80)
(define-resource 'bubble #:image "SpeechBubble.png" -15 -120)
(define-resource 'bug #:image "Enemy Bug.png" 0 -80)
(define-resource 'tree #:image "Tree Tall.png" 0 -80 )
(define-resource 'heart #:image "Heart.png" 0 0 0.5)

(define world '(("~~~~~~~~"
                 "~~####~~"
                 "~######~"
                 "~######~"
                 "~######~"
                 "~~####~~"
                 "~~~~~~~~")
                ("        "
                 "  t tt  "
                 "   b  t "
                 " t      "
                 "     p  "
                 "   t    ")))

(define (draw-world world)
  (loop for l from 0 to (sub1 (length world)) do
        (loop for x from 0 to (sub1 (string-length (car (list-ref world l)))) do
              (loop for y from 0 to (sub1 (length (list-ref world l))) do
                    (let ((tile (case (string-ref (list-ref (list-ref world l) y) x)
                       ((#\~) 'water)
                       ((#\#) 'stone)
                       ((#\b) 'bug)
                       ((#\t) 'tree)
                       ((#\p) 'princess)
                       ((#\h) 'heart)
                       (else #f))))
                      (when tile
                        (blit-image
                         tile
                         (* *field-width* x)
                         (* *field-height* y))))))))

(world-inits
 (lambda ()
   (set-font! "Andale mono" 22 '(0.8 0.2 0 0.9))
   (draw-world world)))

(define *last-blink* 0)
(define *shown* 0)

(world-changes
 (lambda (events dt exit)
   (clear-screen)
   (draw-world world)
   (blit-image 'bubble 600 300)

   (set! *last-blink* (+ *last-blink* dt))
   (rectangle 600 300 100 170 '(1 0 0 1))
   (case *shown*
     ((0) (text 630 300 "I"))
     ((1) (blit-image 'heart 600 300))
     ((2) (text 600 300 "Doodle")))
   (when (>  *last-blink* 0.7)
     (set! *shown* (modulo (add1 *shown*) 3))
     (set! *last-blink* 0))))

(run-event-loop)