;; 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 player1) (read-case-sensitive #t) (teachpacks ((lib "universe.ss" "teachpack" "2htdp") (lib "image.ss" "teachpack" "htdp"))) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ((lib "universe.ss" "teachpack" "2htdp") (lib "image.ss" "teachpack" "htdp"))))) ;; World = Number | 'resting (define WORLD0 'resting) ;; constants (define HEIGHT 100) (define DefWidth 50) ;; visual constants (define mt (nw:rectangle DefWidth HEIGHT 'solid 'gray)) (define BALL (circle 3 'solid 'red)) (define (mtt name width) (place-image (text (format "~a" name) 11 'black) 5 85 (empty-scene width HEIGHT))) ;; ----------------------------------------------------------------------------- ;; World Number -> Message ;; on receiving a message from server, place the ball at lower end or stop (check-expect (receive 'resting 'go) HEIGHT) (check-expect (receive HEIGHT 'go) HEIGHT) (check-expect (receive (- HEIGHT 1) 'go) (- HEIGHT 1)) (check-expect (receive 0 'go) 0) (define (receive w n) (cond [(number? w) w] [else HEIGHT])) ;; World -> Scene ;; render the world (place-image BALL 50 100 mt) (check-expect (draw 100) (place-image BALL 50 100 mt)) (define (draw-name name width) (lambda (w) (cond [(symbol? w) (place-image (text "resting" 11 'red) 10 10 (mtt name width))] [(number? w) (place-image BALL 50 w (mtt name width))]))) (define (draw w) (cond [(symbol? w) (place-image (text "resting" 11 'red) 10 10 mt)] [(number? w) (place-image BALL 50 w mt)])) ;; World -> World (check-expect (move 'resting) 'resting) (check-expect (move HEIGHT) (- HEIGHT 1)) (check-expect (move 0) (make-package 'resting 'go)) (define (move x) (cond [(symbol? x) x] [(number? x) (if (<= x 0) (make-package 'resting 'go) (sub1 x))])) ;; ----------------------------------------------------------------------------- ;; Number (U String Symbol) -> true ;; create and hook up a player with the localhost server (define (make-player width name) (big-bang WORLD0 (on-draw (draw-name name width)) (on-receive receive) (on-tick move) (register LOCALHOST name))) ;; ---