Skip to content
This repository
Fetching contributors…

Cannot retrieve contributors at this time

file 59 lines (49 sloc) 1.693 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59
;; The first three lines of this file were inserted by DrScheme. They record metadata
;; about the language level of this file in a form that our tools can easily process.
#reader(lib "htdp-intermediate-lambda-reader.ss" "lang")((modname balls) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ())))
(require (lib "world.ss" "htdp"))

;; constants
(define height 50)
(define delta 80)
(define width (+ delta (* 2 height)))

(define left (quotient height 2))
(define right (+ height delta left))

;; World = (make-posn left Number) | (make-posn right Number)

(define server (text "server" 11 'black))
(define server* (overlay server (nw:rectangle (image-width server) (image-height server) 'outline 'black)))

;; visual constants
(define bg
  (place-image
   (text "universe" 11 'green)
   60 0
  (place-image
   server*
   (+ height 15) 20
   (place-image
    (text "left" 11 'blue)
    10 10
    (place-image
     (text "right" 11 'red)
     (+ height delta 10) 10
     (place-image
      (nw:rectangle delta height 'solid 'white)
      height 0
      (place-image
       (nw:rectangle width height 'solid 'gray)
       0 0
       (empty-scene width height))))))))

(define ball (circle 3 'solid 'red))

;; World -> Scene
(define (draw w)
  (place-image ball (posn-x w) (posn-y w) bg))


;; World -> World
(define (tick w)
  (local ((define y (posn-y w))
          (define x (posn-x w)))
    (cond
      [(> y 0) (make-posn x (- y 1))]
      [(= x left) (make-posn right height)]
      [(= x right) (make-posn left height)])))

(big-bang width height 1/66 (make-posn left height) true)
(on-redraw draw)
(on-tick-event tick)
Something went wrong with that request. Please try again.