From 45783388ba1d58951a5d7f77583cb7119ac09525 Mon Sep 17 00:00:00 2001 From: Danny Yoo Date: Fri, 19 Aug 2011 16:56:54 -0400 Subject: [PATCH] world now doesn't export image. Added cow example --- examples/cow.rkt | 242 ++++++++++++++++++++++++++++++++ examples/expanding-circle.rkt | 3 +- examples/pacman.rkt | 4 +- examples/rain-world-program.rkt | 1 + examples/whale.rkt | 3 +- world.rkt | 4 +- 6 files changed, 251 insertions(+), 6 deletions(-) create mode 100644 examples/cow.rkt diff --git a/examples/cow.rkt b/examples/cow.rkt new file mode 100644 index 0000000..2b1540b --- /dev/null +++ b/examples/cow.rkt @@ -0,0 +1,242 @@ +#lang planet dyoo/whalesong +(require (planet dyoo/whalesong/js) + (planet dyoo/whalesong/image) + (planet dyoo/whalesong/world)) + + +;; Occupy the whole screen. +(void (call-method body "css" "margin" 0)) +(void (call-method body "css" "padding" 0)) +(void (call-method body "css" "overflow" "hidden")) + +;; A Cow game + + +(define-struct posn (x y)) + +;Graphical Constants +(define COW-LEFT + (open-image-url "http://world.cs.brown.edu/1/clipart/cow-left.png")) +(define COW-RIGHT + (open-image-url "http://world.cs.brown.edu/1/clipart/cow-right.png")) +(define UFO + (open-image-url "http://world.cs.brown.edu/1/clipart/ufo.png")) +(define UFO-CAPTURE + (open-image-url "http://world.cs.brown.edu/1/clipart/ufo-capture.png")) + + +;Physical Constants +(define SCREEN-WIDTH (viewport-width)) +(define SCREEN-HEIGHT (viewport-height)) + +(define BACKGROUND (empty-scene SCREEN-WIDTH SCREEN-HEIGHT)) +(define UFO-HEIGHT (image-height UFO)) +(define UFO-WIDTH (image-width UFO)) +(define HALF-UFO-WIDTH (/ UFO-WIDTH 2)) +(define HALF-UFO-HEIGHT (/ UFO-HEIGHT 2)) +(define COW-HEIGHT (image-height COW-RIGHT)) +(define COW-WIDTH (image-width COW-RIGHT)) +(define HALF-COW-HEIGHT (/ COW-HEIGHT 2)) +(define HALF-COW-WIDTH (/ COW-WIDTH 2)) +(define COW-SPEED 2) +(define UFO-SPEED 5) + +; A cow is a posn and a string +; p : posn dir : string ("right" or "left") +; Represents a cow's position and the direction it faces +(define-struct cow (p dir)) + +(define cow0 (make-cow (make-posn (/ SCREEN-WIDTH 2) (- SCREEN-HEIGHT HALF-COW-HEIGHT)) "right")) +(define cow1 (make-cow (make-posn (/ SCREEN-WIDTH 4) (- SCREEN-HEIGHT HALF-COW-HEIGHT)) "right")) +(define cow2 (make-cow (make-posn (* SCREEN-WIDTH 3/4) (- SCREEN-HEIGHT HALF-COW-HEIGHT)) "left")) + +; A world is a posn and a list-of-cows +; ufo: posn cows: list-of-cows +; Represents the ufo's position and all the cows' positions directions +(define-struct world (ufo cows)) + +(define world-test (make-world (make-posn 10 10) + (list cow0 cow1))) +(define world0 (make-world (make-posn (/ SCREEN-WIDTH 2) HALF-UFO-HEIGHT) + (list cow0 cow1 cow2))) + +; draw-cows: list-of-cows scene -> scene +; draw-cows consumes a list-of-cows and a scene and produces a scene with cows at their posns +; given: a list of three cows (facing "right", "right", and "left") +; should produce: three cows drawn on a scene facing those directions at the bottom of the screen +; given: empty +; should produce: empty scene +(define (draw-cows aloc scene) + (cond + [(null? aloc) scene] + [(pair? aloc) (place-image (cond + [(string=? (cow-dir (car aloc)) "right") + COW-RIGHT] + [(string=? (cow-dir (car aloc)) "left") + COW-LEFT]) + (posn-x (cow-p (car aloc))) + (posn-y (cow-p (car aloc))) + (draw-cows (cdr aloc) scene))])) + + + +; draw-ufo: posn scene img -> scene +; draw-ufo consumes a posn, a scene, and an img and produces a scene with a ufo drawn on the screen at the posn +; given: (make-posn 0 0) (empty-scene 500 500) UFO +; should produce: the UFO appearing on a scene at the top left corner +(define (draw-ufo p scene ufo-img) + (place-image ufo-img (posn-x p) (posn-y p) scene)) + +; draw: world -> scene +; draw consumes a world and produces a scene with all the images +; given: world-test +; should produce: a ufo starting in the middle and three cows drawn on the background. The ufo should move left or right +; depending on whether left or right is pressed on the keyboard, respectively, if the ufo isn't hitting a left or right wall. +; Two cows start facing right, and one faces left. If a cow collides with another cow, both should change direction. If a cow +; runs into a wall, it should change direction. If the ufo hits a cow, it should change images to the ufo captured image. +(define (draw w) + (draw-cows (world-cows w) + (draw-ufo (world-ufo w) + BACKGROUND (if (anything-touching-cow? (world-ufo w) + HALF-UFO-WIDTH + HALF-UFO-HEIGHT + (world-cows w)) UFO-CAPTURE UFO)))) + +; move-ufo-y: world -> world +; move-ufo-y consumes a world and produces a world with the ufo moved down +(define (move-ufo-y w) + (make-world (make-posn (posn-x (world-ufo w)) + (+ UFO-SPEED (posn-y (world-ufo w)))) + (world-cows w))) + + + +; move-ufo-x: world key -> world +; move-ufo-x consumes a world and key and produces a world with the ufo moved by keys +(define (move-ufo-x w key) + (make-world + (make-posn + (cond + [(and (key=? key "left") (not (hitting-wall? (world-ufo w) "left"))) + (- (posn-x (world-ufo w)) UFO-SPEED)] + [(and (key=? key "right") (not (hitting-wall? (world-ufo w) "right"))) + (+ (posn-x (world-ufo w)) UFO-SPEED)] + [else (posn-x (world-ufo w))]) + (posn-y (world-ufo w))) + (world-cows w))) + +;ufo-done? : world -> boolean +;consumes a world and returns true if the ufo is touching any cow or the ground; otherwise, returns false +(define (ufo-done? w) + (or + (anything-touching-cow? (world-ufo w) + HALF-UFO-WIDTH + HALF-UFO-HEIGHT + (world-cows w)) + (hitting-wall? (world-ufo w) "down"))) + + +;anything-touching-cow? : posn num num list-of-posns -> boolean +;anything-touching-cow? consumes a posn, an image height, an image width, and a list-of-cows and returns true if the image at the posns is touching any of the cows in the list based on the image height and width, otherwise returns false +(define (anything-touching-cow? img-p img-w img-h aloc) + (cond + [(null? aloc) false] + [(pair? aloc) + (or + (and + (or + (and (>= (- (posn-x img-p) img-w) (- (posn-x (cow-p (car aloc))) HALF-COW-WIDTH)) + (<= (- (posn-x img-p) img-w) (+ (posn-x (cow-p (car aloc))) HALF-COW-WIDTH))) + (and (>= (+ (posn-x img-p) img-w) (- (posn-x (cow-p (car aloc))) HALF-COW-WIDTH)) + (<= (+ (posn-x img-p) img-w) (+ (posn-x (cow-p (car aloc))) HALF-COW-WIDTH)))) + (>= (+ (posn-y img-p) img-h) (- (posn-y (cow-p (car aloc))) HALF-COW-HEIGHT))) + (anything-touching-cow? img-p img-w img-h (cdr aloc)))])) + + +;remove-cow-from-list : cow list-of-cows -> list-of-cows +;remove-cow-from-list consumes a cow and a list-of-cows and returns a list-of-cows with cow removed +(define (remove-cow-from-list c aloc) + (cond + [(null? aloc) '()] + [(pair? aloc) (cond + [(posn=? (cow-p c) (cow-p (car aloc))) (cdr aloc)] + [else (cons (car aloc) (remove-cow-from-list c (cdr aloc)))])])) + + +;process-cows : world -> world +;process-cows consumes a world and produces a world with the cows moved and hit-tested +(define (process-cows w) + (make-world (world-ufo w) (move-cows (new-dirs (world-cows w) (world-cows w))))) + + +;move-all-on-tick : world -> world +;move-all-on-tick consumes a world and produces a world with all objects inside of it moved every "tick" of big-bang +(define (move-all-on-tick w) + (process-cows (move-ufo-y w))) + + +;move-cows : list-of-cows -> list-of-cows +;move-cows consumes a list-of-cows and produces a list of cows moved to the left or right depending on the cows' directions +(define (move-cows aloc) + (cond + [(null? aloc) '()] + [(pair? aloc) (cons + (make-cow + (make-posn + ( + (cond + [(string=? (cow-dir (car aloc)) "right") +] + [(string=? (cow-dir (car aloc)) "left") -]) + (posn-x (cow-p (car aloc))) COW-SPEED) + (posn-y (cow-p (car aloc)))) + (cow-dir (car aloc))) + (move-cows (cdr aloc)))])) + + +;new-dirs : list-of-cows list-of-cows -> list-of-cows +;consumes two identical lists-of-cows and produces a list-of-cows in which all cows' dirs are updated +;e.g. changes the cow's direction if it collides with another cow or reaches the edge of the screen, otherwise leaves it unchanged +(define (new-dirs aloc1 aloc2) + (cond + [(null? aloc1) '()] + [(pair? aloc1) (cons (make-cow (cow-p (car aloc1)) + (update-dir (car aloc1) aloc2)) + (new-dirs (cdr aloc1) aloc2))])) + + +;update-dir : cow list-of-cows -> String +;update-dir consumes a cow and a list-of-cows and changes it's direction if it hits a wall or another cow +(define (update-dir c aloc) + (cond + [(hitting-wall? (cow-p c) "right") "left"] + [(hitting-wall? (cow-p c) "left") "right"] + [(anything-touching-cow? (cow-p c) HALF-COW-WIDTH HALF-COW-HEIGHT (remove-cow-from-list c aloc)) + (cond + [(string=? (cow-dir c) "left") "right"] + [(string=? (cow-dir c) "right") "left"])] + [else (cow-dir c)])) + +;hitting-wall? : posn String -> boolean +;hitting-wall? consumes a posn and a direction and returns true if the posn is past the edge of the screen in that direction +;otherwise returns false +(define (hitting-wall? p dir) + (cond + [(string=? dir "right") (> (posn-x p) SCREEN-WIDTH)] + [(string=? dir "left") (< (posn-x p) 0)] + [(string=? dir "down") (> (posn-y p) SCREEN-HEIGHT)])) + + +;posn=? : posn posn -> boolean +;posn=? consumes two posns and returns true if they are equal, otherwise returns false +(define (posn=? p1 p2) + (and + (= (posn-x p1) (posn-x p2)) + (= (posn-y p1) (posn-y p2)))) + + +;big-bang creates the world +(big-bang world0 + (to-draw draw) + (on-key move-ufo-x) + (on-tick move-all-on-tick) + (stop-when ufo-done?)) \ No newline at end of file diff --git a/examples/expanding-circle.rkt b/examples/expanding-circle.rkt index cdadd05..aa7e1a3 100644 --- a/examples/expanding-circle.rkt +++ b/examples/expanding-circle.rkt @@ -1,6 +1,7 @@ #lang planet dyoo/whalesong -(require (planet dyoo/whalesong/world)) +(require (planet dyoo/whalesong/world) + (planet dyoo/whalesong/image)) (define handler (on-tick add1 1)) diff --git a/examples/pacman.rkt b/examples/pacman.rkt index b321aa0..be49af5 100644 --- a/examples/pacman.rkt +++ b/examples/pacman.rkt @@ -1,6 +1,8 @@ #lang planet dyoo/whalesong -(require (planet dyoo/whalesong/world)) +(require (planet dyoo/whalesong/world) + (planet dyoo/whalesong/image) + ) ;; Constants: diff --git a/examples/rain-world-program.rkt b/examples/rain-world-program.rkt index 65b4fa7..4a1d153 100644 --- a/examples/rain-world-program.rkt +++ b/examples/rain-world-program.rkt @@ -1,6 +1,7 @@ #lang planet dyoo/whalesong (require (planet dyoo/whalesong/world) + (planet dyoo/whalesong/image) (planet dyoo/whalesong/js)) ;; Occupy the whole screen. diff --git a/examples/whale.rkt b/examples/whale.rkt index 1de51dd..cba2858 100644 --- a/examples/whale.rkt +++ b/examples/whale.rkt @@ -1,6 +1,7 @@ #lang planet dyoo/whalesong -(require (planet dyoo/whalesong/world)) +(require (planet dyoo/whalesong/world) + (planet dyoo/whalesong/image)) (define-struct world (x direction)) diff --git a/world.rkt b/world.rkt index aed2383..0204d7f 100644 --- a/world.rkt +++ b/world.rkt @@ -1,6 +1,4 @@ #lang s-exp "lang/base.rkt" (require "world/main.rkt") -(require "image.rkt") -(provide (all-from-out "world/main.rkt") - (all-from-out "image.rkt")) +(provide (all-from-out "world/main.rkt"))