net: five: ufo.rkt: Make UFO fart when it moves.

3 files changed, 228 insertions, 24 deletions

diff --git a/net/ricketyspace/ror/five/resources/ufo-fart.png b/net/ricketyspace/ror/five/resources/ufo-fart.png
new file mode 100644
index 0000000..13d1c4a
--- /dev/null
+++ b/net/ricketyspace/ror/five/resources/ufo-fart.png
diff --git a/net/ricketyspace/ror/five/resources/ufo-fart.svg b/net/ricketyspace/ror/five/resources/ufo-fart.svg
new file mode 100644
index 0000000..cf86021
--- /dev/null
+++ b/net/ricketyspace/ror/five/resources/ufo-fart.svg
@@ -0,0 +1,188 @@
+<?xml version="1.0" encoding="UTF-8" standalone="no"?>
+<!-- Created with Inkscape (http://www.inkscape.org/) -->
+
+<svg
+   xmlns:dc="http://purl.org/dc/elements/1.1/"
+   xmlns:cc="http://creativecommons.org/ns#"
+   xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
+   xmlns:svg="http://www.w3.org/2000/svg"
+   xmlns="http://www.w3.org/2000/svg"
+   xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
+   xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"
+   width="50"
+   height="50"
+   viewBox="0 0 13.229166 13.229167"
+   version="1.1"
+   id="svg8"
+   inkscape:version="0.92.3 (2405546, 2018-03-11)"
+   sodipodi:docname="ufo-gas.svg">
+  <title
+     id="title10">UFO Fart</title>
+  <defs
+     id="defs2" />
+  <sodipodi:namedview
+     id="base"
+     pagecolor="#ffffff"
+     bordercolor="#666666"
+     borderopacity="1.0"
+     inkscape:pageopacity="0.0"
+     inkscape:pageshadow="2"
+     inkscape:zoom="7.9195959"
+     inkscape:cx="19.4951"
+     inkscape:cy="22.795424"
+     inkscape:document-units="mm"
+     inkscape:current-layer="layer1"
+     showgrid="false"
+     units="px"
+     inkscape:window-width="1280"
+     inkscape:window-height="800"
+     inkscape:window-x="0"
+     inkscape:window-y="0"
+     inkscape:window-maximized="0" />
+  <metadata
+     id="metadata5">
+    <rdf:RDF>
+      <cc:Work
+         rdf:about="">
+        <dc:format>image/svg+xml</dc:format>
+        <dc:type
+           rdf:resource="http://purl.org/dc/dcmitype/StillImage" />
+        <dc:title>UFO Fart</dc:title>
+        <cc:license
+           rdf:resource="http://creativecommons.org/publicdomain/zero/1.0/" />
+        <dc:date>2018-04-17</dc:date>
+        <dc:creator>
+          <cc:Agent>
+            <dc:title>rsiddharth &lt;s@ricketyspace.net&gt;</dc:title>
+          </cc:Agent>
+        </dc:creator>
+      </cc:Work>
+      <cc:License
+         rdf:about="http://creativecommons.org/publicdomain/zero/1.0/">
+        <cc:permits
+           rdf:resource="http://creativecommons.org/ns#Reproduction" />
+        <cc:permits
+           rdf:resource="http://creativecommons.org/ns#Distribution" />
+        <cc:permits
+           rdf:resource="http://creativecommons.org/ns#DerivativeWorks" />
+      </cc:License>
+    </rdf:RDF>
+  </metadata>
+  <g
+     inkscape:label="Layer 1"
+     inkscape:groupmode="layer"
+     id="layer1"
+     transform="translate(0,-283.77082)">
+    <g
+       id="g160">
+      <circle
+         style="fill:#ffffff;stroke-width:0.09590441"
+         r="0.071714237"
+         cy="288.4332"
+         cx="4.474267"
+         id="circle38" />
+    </g>
+    <g
+       id="g202"
+       inkscape:export-xdpi="76.796082"
+       inkscape:export-ydpi="76.796082">
+      <g
+         id="g180">
+        <circle
+           style="stroke-width:0.20158729"
+           r="0.53453904"
+           cy="285.58438"
+           cx="6.4067097"
+           id="circle20" />
+        <circle
+           style="fill:#ffffff;stroke-width:0.06017532"
+           r="0.044997171"
+           cy="285.91135"
+           cx="6.4122667"
+           id="circle22" />
+      </g>
+      <g
+         id="g132">
+        <circle
+           style="stroke-width:0.42837298"
+           r="1.1358955"
+           cy="294.70496"
+           cx="2.898797"
+           id="circle42" />
+        <circle
+           style="fill:#ffffff;stroke-width:0.12787254"
+           r="0.095618986"
+           cy="295.48981"
+           cx="2.5584671"
+           id="circle44" />
+      </g>
+      <circle
+         id="circle36"
+         cx="4.920023"
+         cy="287.93967"
+         r="0.85192156"
+         style="stroke-width:0.32127973"
+         transform="translate(0,9.1666667e-6)" />
+      <g
+         id="g176">
+        <circle
+           style="stroke-width:0.32127973"
+           r="0.85192156"
+           cy="287.83945"
+           cx="8.294301"
+           id="circle48" />
+        <circle
+           style="fill:#ffffff;stroke-width:0.09590441"
+           r="0.071714237"
+           cy="288.35379"
+           cx="8.6660032"
+           id="circle50" />
+      </g>
+      <g
+         id="g136">
+        <circle
+           id="path12"
+           cx="3.9511709"
+           cy="291.24713"
+           r="1.2528259"
+           style="stroke-width:0.47247022" />
+        <circle
+           id="path14"
+           cx="3.5711958"
+           cy="292.09247"
+           r="0.10546212"
+           style="fill:#ffffff;stroke-width:0.1410359" />
+      </g>
+      <g
+         id="g152">
+        <circle
+           style="stroke-width:0.47247022"
+           r="1.2528259"
+           cy="291.31396"
+           cx="9.7308741"
+           id="circle54" />
+        <circle
+           style="fill:#ffffff;stroke-width:0.1410359"
+           r="0.10546212"
+           cy="292.10916"
+           cx="10.269638"
+           id="circle56" />
+      </g>
+      <g
+         id="g156">
+        <circle
+           id="circle66"
+           cx="10.549387"
+           cy="294.57132"
+           r="1.1358955"
+           style="stroke-width:0.42837298" />
+        <circle
+           id="circle68"
+           cx="10.976822"
+           cy="295.35028"
+           r="0.095618986"
+           style="fill:#ffffff;stroke-width:0.12787254" />
+      </g>
+    </g>
+  </g>
+</svg>
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))