All pastes #2082873 Raw Edit

Stuff

public text v1 · immutable
#2082873 ·published 2011-09-26 00:49 UTC
rendered paste body
(require 2htdp/image)
(require 2htdp/universe)

(define-struct position (x y))

(define-struct velocity (speed direction))

(define-struct ball (radius velocity position))

;;(define Ball (make-ball 10 (make-velocity 10 "up")(make-position "100" "100")))

(define (ball-next Ball)
  (make-ball 10 (make-velocity (velocity-speed (ball-velocity Ball)) (velocity-direction (ball-velocity Ball)))
             (cond
               [(string=? "up" (velocity-direction (ball-velocity Ball))) 
                (make-position (position-x (ball-position Ball)) (- (position-y (ball-position Ball)) (velocity-speed (ball-velocity Ball))))]
               [(string=? "down" (velocity-direction (ball-velocity Ball)))
                (make-position (position-x (ball-position Ball)) (+ (position-y (ball-position Ball)) (velocity-speed (ball-velocity Ball))))]
               [(string=? "left" (velocity-direction (ball-velocity Ball)))
                (make-position (-(position-x (ball-position Ball))(velocity-speed (ball-velocity Ball))) (position-y (ball-position Ball)))]
               [(string=? "right" (velocity-direction (ball-velocity Ball))) 
                (make-position (+(position-x (ball-position Ball))(velocity-speed (ball-velocity Ball))) (position-y (ball-position Ball)))])))

(define (ball-image Ball)
  (place-image (circle (ball-radius Ball) "solid" "red") (position-x (ball-position Ball))(position-y (ball-position Ball))  (empty-scene 300 300)))


(define (ball-change Ball key)
  (cond
    [(key=? "up" key)
     (make-ball 10 (make-velocity (velocity-speed (ball-velocity Ball)) key)(make-position (position-x (ball-position Ball)) (position-y (ball-position Ball))))]
    [(key=? "down" key)
     (make-ball 10 (make-velocity (velocity-speed (ball-velocity Ball)) key)(make-position (position-x (ball-position Ball)) (position-y (ball-position Ball))))]
    [(key=? "left" key)
     (make-ball 10 (make-velocity (velocity-speed (ball-velocity Ball)) key)(make-position (position-x (ball-position Ball)) (position-y (ball-position Ball))))]
    [(key=? "right" key)
     (make-ball 10 (make-velocity (velocity-speed (ball-velocity Ball)) key)(make-position (position-x (ball-position Ball)) (position-y (ball-position Ball))))]))

(big-bang (make-ball 10 (make-velocity 10 "up")(make-position 150 150))
  (on-tick ball-next 1/28)
  (to-draw ball-image)
  (on-key ball-change))