1 files changed, 40 insertions, 24 deletions
diff --git a/net/ricketyspace/ror/five/ufo.rkt b/net/ricketyspace/ror/five/ufo.rkt
index 1bf7910..6f8136c 100644
--- a/net/ricketyspace/ror/five/ufo.rkt
+++ b/net/ricketyspace/ror/five/ufo.rkt
@@ -2,59 +2,70 @@
 (require 2htdp/universe 2htdp/image)
 
 ;;; world structure
-(struct ufo-pos (x y))
+(struct ufo (x y fart))
 
 ;;; constants
 (define WORLD-WIDTH 300)
 (define WORLD-HEIGHT 325)
 (define MOVE-LEN 3)
 (define UFO (bitmap/file "resources/zarking-ufo.png"))
+(define UFO-FART (bitmap/file "resources/ufo-fart.png"))
 (define UFO-WIDTH (image-width UFO))
 (define UFO-HEIGHT (image-height UFO))
+(define UFO-FART-HEIGHT (image-height UFO-FART))
 
 ;;; ufo movement functions
 (define (ufo-move-up current-state)
-  (let ((x (ufo-pos-x current-state))
-        (y-up (- (ufo-pos-y current-state) MOVE-LEN)))
-    (cond [(>= y-up (/ UFO-HEIGHT 2)) (ufo-pos x y-up)]
+  (let ((x (ufo-x current-state))
+        (y-up (- (ufo-y current-state) MOVE-LEN))
+        (fart #t))
+    (cond [(>= y-up (+ (/ UFO-HEIGHT 2) (/ UFO-FART-HEIGHT 2)))
+           (ufo x y-up fart)]
           [else current-state])))
 
 (define (ufo-move-down current-state)
-  (let ((x (ufo-pos-x current-state))
-        (y-down (+ (ufo-pos-y current-state) MOVE-LEN)))
-    (cond [(<= y-down (- WORLD-HEIGHT (/ UFO-HEIGHT 2)))
-           (ufo-pos x y-down)]
+  (let ((x (ufo-x current-state))
+        (y-down (+ (ufo-y current-state) MOVE-LEN)))
+    (cond [(<= y-down (- (+ WORLD-HEIGHT (/ UFO-FART-HEIGHT 2))
+                         (/ UFO-HEIGHT 2)))
+           (ufo x y-down #t)]
           [else current-state])))
 
 
 (define (ufo-move-left current-state)
-  (let ((x-left (- (ufo-pos-x current-state) MOVE-LEN))
-        (y (ufo-pos-y current-state)))
+  (let ((x-left (- (ufo-x current-state) MOVE-LEN))
+        (y (ufo-y current-state))
+        (fart #t))
     (cond [(>= x-left (/ UFO-WIDTH 2))
-           (ufo-pos x-left y)]
+           (ufo x-left y fart)]
           [else current-state])))
 
 (define (ufo-move-right current-state)
-  (let ((x-right (+ (ufo-pos-x current-state) MOVE-LEN))
-        (y (ufo-pos-y current-state)))
+  (let ((x-right (+ (ufo-x current-state) MOVE-LEN))
+        (y (ufo-y current-state))
+        (fart #t))
     (cond [(<= x-right (- WORLD-WIDTH (/ UFO-WIDTH 2)))
-           (ufo-pos x-right y)]
+           (ufo x-right y fart)]
           [else current-state])))
 
 
 ;;; big bang functions
-(define (draw-a-ufo-onto-an-empty-scene current-state)
-  (place-image UFO
-               (ufo-pos-x current-state)
-               (ufo-pos-y current-state)
+(define (draw-a-ufo current-state)
+  (place-image (overlay/align/offset
+                "middle" "bottom" UFO 0 35
+                (if (ufo-fart current-state)
+                    UFO-FART
+                    (circle 0 "outline" "white")))
+               (ufo-x current-state)
+               (ufo-y current-state)
                (empty-scene WORLD-WIDTH WORLD-HEIGHT)))
 
 (define (add-3-to-posy current-state)
-  (ufo-pos (ufo-pos-x current-state)
-           (+ (ufo-pos-y current-state) 3)))
+  (ufo (ufo-x current-state)
+           (+ (ufo-y current-state) 3)))
 
 (define (posy-is-300 current-state)
-  (>= (ufo-pos-y current-state) 300))
+  (>= (ufo-y current-state) 300))
 
 (define (move-ufo current-state key)
   (cond [(key=? key "up") (ufo-move-up current-state)]
@@ -63,8 +74,13 @@
         [(key=? key "right") (ufo-move-right current-state)]
         [else current-state]))
 
+(define (ufo-stopped current-state key)
+  (let ((fart #f))
+    (ufo (ufo-x current-state) (ufo-y current-state) fart)))
+
 ;;; the big bang
-(big-bang (ufo-pos (/ WORLD-WIDTH 2) (/ WORLD-HEIGHT 2))
-          (to-draw draw-a-ufo-onto-an-empty-scene)
-          (on-key move-ufo))
+(big-bang (ufo (/ WORLD-WIDTH 2) (/ WORLD-HEIGHT 2) #f)
+          (to-draw draw-a-ufo)
+          (on-key move-ufo)
+          (on-release ufo-stopped))