crazy idea to do the presentation as a world program
This commit is contained in:
Danny Yoo
parent
8f4518354a
commit
88d6626451
|
|
@ -220,6 +220,15 @@ EXPORTS['step-count?'] =
|
|||
});
|
||||
|
||||
|
||||
EXPORTS['image?'] =
|
||||
makePrimitiveProcedure(
|
||||
'image?',
|
||||
1,
|
||||
function(MACHINE) {
|
||||
return isImage(MACHINE.env[MACHINE.env.length - 1]);
|
||||
});
|
||||
|
||||
|
||||
|
||||
EXPORTS['text'] =
|
||||
makePrimitiveProcedure(
|
||||
|
|
|
|||
|
|
@ -61,6 +61,8 @@
|
|||
angle?
|
||||
side-count?
|
||||
step-count?
|
||||
|
||||
image?
|
||||
|
||||
))
|
||||
|
||||
|
|
|
|||
|
|
@ -55,6 +55,9 @@
|
|||
side-count?
|
||||
image-color?
|
||||
|
||||
|
||||
image?
|
||||
|
||||
;; Something funky is happening on the Racket side of things with regards
|
||||
;; to step-count? See: http://bugs.racket-lang.org/query/?cmd=view&pr=12031
|
||||
;; step-count?
|
||||
|
|
|
|||
|
|
@ -1352,6 +1352,13 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
|
|||
});
|
||||
|
||||
|
||||
installPrimitiveProcedure(
|
||||
'string?',
|
||||
1,
|
||||
function(MACHINE) {
|
||||
return isString(MACHINE.env[MACHINE.env.length - 1]);
|
||||
});
|
||||
|
||||
installPrimitiveProcedure(
|
||||
'exact?',
|
||||
1,
|
||||
|
|
|
|||
|
|
@ -255,7 +255,7 @@ error
|
|||
;; immutable?
|
||||
;; void?
|
||||
symbol?
|
||||
;; string?
|
||||
string?
|
||||
;; char?
|
||||
;; boolean?
|
||||
vector?
|
||||
|
|
|
|||
23
racketcon/hello.rkt
Normal file
23
racketcon/hello.rkt
Normal file
|
|
@ -0,0 +1,23 @@
|
|||
#lang planet dyoo/whalesong/bf
|
||||
|
||||
+++++ +++++ initialize counter (cell #0) to 10
|
||||
[ use loop to set the next four cells to 70/100/30/10
|
||||
> +++++ ++ add 7 to cell #1
|
||||
> +++++ +++++ add 10 to cell #2
|
||||
> +++ add 3 to cell #3
|
||||
> + add 1 to cell #4
|
||||
<<<< - decrement counter (cell #0)
|
||||
]
|
||||
> ++ . print 'H'
|
||||
> + . print 'e'
|
||||
+++++ ++ . print 'l'
|
||||
. print 'l'
|
||||
+++ . print 'o'
|
||||
> ++ . print ' '
|
||||
<< +++++ +++++ +++++ . print 'W'
|
||||
> . print 'o'
|
||||
+++ . print 'r'
|
||||
----- - . print 'l'
|
||||
----- --- . print 'd'
|
||||
> + . print '!'
|
||||
> . print '\n'
|
||||
41927
racketcon/hello.xhtml
Normal file
41927
racketcon/hello.xhtml
Normal file
File diff suppressed because it is too large
Load Diff
450
racketcon/pacman.rkt
Normal file
450
racketcon/pacman.rkt
Normal file
|
|
@ -0,0 +1,450 @@
|
|||
#lang planet dyoo/whalesong
|
||||
|
||||
(require (planet dyoo/whalesong/world))
|
||||
|
||||
|
||||
;; Constants:
|
||||
|
||||
(define E "empty") ;See CellValue data definition below
|
||||
(define D "dot") ;
|
||||
(define W "wall") ;
|
||||
|
||||
(define INIT-BOARD ;See Board data definition below
|
||||
(vector (vector W W W W W W W W W W W W W)
|
||||
(vector W D D D D D D D D D D D W)
|
||||
(vector W D W D W W W W W D W D W)
|
||||
(vector W D W D W D D D W D W D W)
|
||||
(vector W D W D D D W D D D W D W)
|
||||
(vector W D W W D W W W D W W D W)
|
||||
(vector W D D D D D E D D D D D W)
|
||||
(vector W W W W W W W W W W W W W)))
|
||||
|
||||
(define SMALL-BOARD
|
||||
(vector (vector E E E)
|
||||
(vector E E E)))
|
||||
|
||||
(define CELL-SIZE 20)
|
||||
|
||||
(define BOARD-WIDTH (* CELL-SIZE (vector-length (vector-ref INIT-BOARD 0))))
|
||||
(define BOARD-HEIGHT (* CELL-SIZE (vector-length INIT-BOARD)))
|
||||
|
||||
(define SMALL-BOARD-WIDTH (* CELL-SIZE (vector-length (vector-ref SMALL-BOARD 0))))
|
||||
(define SMALL-BOARD-HEIGHT (* CELL-SIZE (vector-length SMALL-BOARD)))
|
||||
|
||||
(define SCORE-HEIGHT 30)
|
||||
(define SCORE-TEXT-SIZE 20)
|
||||
|
||||
(define PM (circle 10 "solid" "yellow"))
|
||||
|
||||
(define MTC (rectangle CELL-SIZE CELL-SIZE "solid" "black")) ; empty cell
|
||||
(define DTC (overlay (circle 3 "solid" "white") MTC)) ; dot in cell
|
||||
(define WALL (rectangle CELL-SIZE CELL-SIZE "solid" "blue")) ; wall
|
||||
|
||||
(define MTB
|
||||
(empty-scene BOARD-WIDTH
|
||||
(+ BOARD-HEIGHT SCORE-HEIGHT)))
|
||||
|
||||
(define SMALL-MTB
|
||||
(empty-scene SMALL-BOARD-WIDTH
|
||||
(+ SMALL-BOARD-HEIGHT SCORE-HEIGHT)))
|
||||
|
||||
|
||||
|
||||
;; Data definitions:
|
||||
|
||||
|
||||
;; Score is Natural
|
||||
;; interp. dots eaten by pac-man since start of game
|
||||
|
||||
(define INIT-SCORE 0)
|
||||
|
||||
;; CellValue is one of:
|
||||
;; - "empty"
|
||||
;; - "dot"
|
||||
;; - "wall"
|
||||
;; interp. the content of a board cell
|
||||
|
||||
;; Direction is one of:
|
||||
;; - "U"
|
||||
;; - "D"
|
||||
;; - "L"
|
||||
;; - "R"
|
||||
;; interp. direction that a sprite is facing
|
||||
|
||||
(define-struct sprite (x y dir))
|
||||
;; Sprite is (make-sprite Natural Natural Direction)
|
||||
;; interp. the position in Board coordinates, and the direction of a sprite
|
||||
|
||||
(define INIT-PM (make-sprite 6 6 "U"))
|
||||
|
||||
;; Board is (vectorof (vectorof CellValue))
|
||||
;; interp. the game board
|
||||
|
||||
(define RENDER-TEST-BOARD (vector (vector W E)
|
||||
(vector D E)))
|
||||
|
||||
(define-struct gs (pm board board-image score))
|
||||
;; GameState is (make-gs Sprite Board Image Score)
|
||||
;; interp. all parts of the pac-man game; pac-man, the current
|
||||
;; board, the current board image, and the current score
|
||||
|
||||
(define MTB-GS (make-gs INIT-PM INIT-BOARD MTB INIT-SCORE))
|
||||
|
||||
|
||||
;;-------------------------------------------------------------------------------------
|
||||
;;-------------------------------------------------------------------------------------
|
||||
;;-------------------------------------------------------------------------------------
|
||||
;; Testing values:
|
||||
|
||||
;; Sprite:
|
||||
(define R-SPRITE (make-sprite 1 1 "R"))
|
||||
(define L-SPRITE (make-sprite 1 1 "L"))
|
||||
(define U-SPRITE (make-sprite 1 1 "U"))
|
||||
(define D-SPRITE (make-sprite 1 1 "D"))
|
||||
|
||||
;; Board:
|
||||
(define EE-BOARD (vector (vector W W W W)
|
||||
(vector W E E W)
|
||||
(vector W W W W)))
|
||||
|
||||
(define ED-BOARD (vector (vector W W W W)
|
||||
(vector W E D W)
|
||||
(vector W W W W)))
|
||||
|
||||
(define DD-BOARD (vector (vector W W W W)
|
||||
(vector W D D W)
|
||||
(vector W W W W)))
|
||||
|
||||
;; GameState:
|
||||
;; MTB-GS previously defined above
|
||||
(define END-GS (make-gs R-SPRITE EE-BOARD SMALL-MTB 0))
|
||||
|
||||
|
||||
;;-------------------------------------------------------------------------------------
|
||||
;;-------------------------------------------------------------------------------------
|
||||
;;-------------------------------------------------------------------------------------
|
||||
;; Functions:
|
||||
|
||||
|
||||
;;-------------------------------------------------------------------------------------
|
||||
;;-------------------------------------------------------------------------------------
|
||||
;;-------------------------------------------------------------------------------------
|
||||
;; on-tick handler:
|
||||
|
||||
|
||||
;; GameState -> GameState
|
||||
;; advances the game
|
||||
|
||||
(define (tick gs)
|
||||
(local [(define pm (gs-pm gs))
|
||||
(define board (gs-board gs))
|
||||
(define board-image (gs-board-image gs))
|
||||
(define score (gs-score gs))
|
||||
(define new-pm (tick-pm pm board))
|
||||
(define new-board (tick-board board new-pm))
|
||||
(define new-board-image (tick-board-image board board-image new-pm))
|
||||
(define new-score (tick-score new-pm board score))]
|
||||
(make-gs new-pm
|
||||
new-board
|
||||
new-board-image
|
||||
new-score)))
|
||||
|
||||
;; Sprite Board -> Sprite
|
||||
;; updates pac-man's position based on its direction
|
||||
(define (tick-pm pm bd)
|
||||
(local [(define x (sprite-x pm))
|
||||
(define y (sprite-y pm))
|
||||
(define dir (sprite-dir pm))]
|
||||
(make-sprite (checked-move-x x y dir bd)
|
||||
(checked-move-y x y dir bd)
|
||||
dir)))
|
||||
|
||||
;; Natural Natural Direction Board -> Natural
|
||||
;; moves x in direction dir, unless it runs into a wall on bd or dir is not in the x direction
|
||||
;; ASSUMPTION: assumes x, y is at least one cell away from any edge of bd
|
||||
|
||||
(define (checked-move-x x y dir bd)
|
||||
(cond [(string=? "L" dir) (restrict-move (sub1 x) y x (sub1 x) bd)]
|
||||
[(string=? "R" dir) (restrict-move (add1 x) y x (add1 x) bd)]
|
||||
[else x]))
|
||||
|
||||
;; Natural Natural Direction Board -> Natural
|
||||
;; moves y in direction dir, unless it runs into a wall on bd or dir is not in the y direction
|
||||
;; ASSUMPTION: assumes x, y is at least one cell away from any edge of bd
|
||||
|
||||
(define (checked-move-y x y dir bd)
|
||||
(cond [(string=? "U" dir) (restrict-move x (sub1 y) y (sub1 y) bd)]
|
||||
[(string=? "D" dir) (restrict-move x (add1 y) y (add1 y) bd)]
|
||||
[else y]))
|
||||
|
||||
;; Natural Natural Natural Natural Board -> Natural
|
||||
;; produces new-coord if bd does not contain a wall at check-x, check-y; otherwise produces old-coord
|
||||
|
||||
(define (restrict-move check-x check-y old-coord new-coord bd)
|
||||
(if (string=? (board-ref bd check-x check-y) "wall")
|
||||
old-coord
|
||||
new-coord))
|
||||
|
||||
;; Board Sprite -> Board
|
||||
;; if cell at pacman's position is not empty, make a new board in which it is
|
||||
|
||||
(define (tick-board bd pm)
|
||||
(local [(define x (sprite-x pm))
|
||||
(define y (sprite-y pm))]
|
||||
(if (string=? (board-ref bd x y) "empty")
|
||||
bd
|
||||
(new-board-w-empty-at x y bd))))
|
||||
|
||||
;; Number Number Board -> Board
|
||||
;; produces a new board with an empty cell at x, y
|
||||
|
||||
(define (new-board-w-empty-at x0 y0 bd)
|
||||
(map-board (lambda (x y cv)
|
||||
(if (and (= x0 x) (= y0 y))
|
||||
"empty"
|
||||
cv))
|
||||
bd))
|
||||
|
||||
;; Board Image Sprite -> Image
|
||||
;; updates the board image with an empty cell at x, y if pac-man is in a cell with a dot
|
||||
(define (tick-board-image bd board-image pm)
|
||||
(local [(define x (sprite-x pm))
|
||||
(define y (sprite-y pm))]
|
||||
(if (string=? (board-ref bd x y) "dot")
|
||||
(place-cell-image MTC x y board-image)
|
||||
board-image)))
|
||||
|
||||
;; Sprite Board Score -> Score
|
||||
;; increases by 1 the score if pac-man is now in a cell containing a dot
|
||||
(define (tick-score new-pm last-board score)
|
||||
(local [(define x (sprite-x new-pm))
|
||||
(define y (sprite-y new-pm))]
|
||||
(cond [(string=? (board-ref last-board x y) "dot")
|
||||
(add1 score)]
|
||||
[else score])))
|
||||
|
||||
|
||||
;;-------------------------------------------------------------------------------------
|
||||
;;-------------------------------------------------------------------------------------
|
||||
;;-------------------------------------------------------------------------------------
|
||||
;; on-key handler:
|
||||
|
||||
|
||||
;; GameState KeyEvent -> GameState
|
||||
;; updates pac-man's direction based on key
|
||||
(define (key-handler gs key)
|
||||
(make-gs (new-dir-pm (gs-pm gs) key)
|
||||
(gs-board gs)
|
||||
(gs-board-image gs)
|
||||
(gs-score gs)))
|
||||
|
||||
;; Sprite KeyEvent -> Sprite
|
||||
;; produces pac-man facing in a new direction based on key
|
||||
(define (new-dir-pm pm key)
|
||||
(cond [(key=? "up" key) (make-sprite (sprite-x pm) (sprite-y pm) "U")]
|
||||
[(key=? "down" key) (make-sprite (sprite-x pm) (sprite-y pm) "D")]
|
||||
[(key=? "left" key) (make-sprite (sprite-x pm) (sprite-y pm) "L")]
|
||||
[(key=? "right" key) (make-sprite (sprite-x pm) (sprite-y pm) "R")]
|
||||
[else pm]))
|
||||
|
||||
|
||||
;;-------------------------------------------------------------------------------------
|
||||
;;-------------------------------------------------------------------------------------
|
||||
;;-------------------------------------------------------------------------------------
|
||||
;; on-tilt handler:
|
||||
|
||||
|
||||
;; ;; GameState Number Number Number -> GameState
|
||||
;; ;; change pac-man's direction based on tilt
|
||||
;; (define (tilt-handler gs yaw pitch roll)
|
||||
;; (make-gs (tilt-pm (gs-pm gs) pitch roll)
|
||||
;; (gs-board gs)
|
||||
;; (gs-board-image gs)
|
||||
;; (gs-score gs)))
|
||||
|
||||
;; ;; Sprite Number Number -> Sprite
|
||||
;; ;; changes pac-man's Direction based on pitch and roll
|
||||
;; (define (tilt-pm pm pitch roll)
|
||||
;; (make-sprite (sprite-x pm)
|
||||
;; (sprite-y pm)
|
||||
;; (tilt->dir (sprite-dir pm) pitch roll)))
|
||||
|
||||
;; ;; Direction Number Number -> Direction
|
||||
;; ;; changes Direction if there is a prominant tilt, otherwise produces old dir
|
||||
;; (define (tilt->dir dir pitch roll)
|
||||
;; (cond [(> (abs pitch) (abs roll))
|
||||
;; (if (positive? pitch)
|
||||
;; "U"
|
||||
;; "D")]
|
||||
;; [(> (abs roll) (abs pitch))
|
||||
;; (if (positive? roll)
|
||||
;; "R"
|
||||
;; "L")]
|
||||
;; [else dir]))
|
||||
|
||||
;; (define (key-handler gs a-key)
|
||||
;; (make-gs (key-pm pm a-key)
|
||||
;; (gs-board gs)
|
||||
;; (gs-board-image gs)
|
||||
;; (gs-source gs)))
|
||||
|
||||
;; (define (key-pm pm a-key)
|
||||
;; (make-sprite (sprite-x pm)
|
||||
;; (sprite-y pm)
|
||||
;; (cond
|
||||
;; [(key=? a-key "left")
|
||||
;; "L"]
|
||||
;; [(key=? a-key "right")
|
||||
;; "R"]
|
||||
;; [(key=? a-key "up")
|
||||
;; "U"]
|
||||
;; [(key=? a-key "down")
|
||||
;; "D"]
|
||||
;; [else
|
||||
;; (sprite-dir pm)])))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
;;-------------------------------------------------------------------------------------
|
||||
;;-------------------------------------------------------------------------------------
|
||||
;;-------------------------------------------------------------------------------------
|
||||
;; stop-when handler:
|
||||
|
||||
|
||||
;; GameState -> Boolean
|
||||
;; determines if pac-man has eaten all the dots
|
||||
(define (game-over? gs)
|
||||
(empty-board? (gs-board gs)))
|
||||
|
||||
;; Board -> Boolean
|
||||
;; determines if the board is empty
|
||||
(define (empty-board? bd)
|
||||
(foldr-board (lambda (x y cv b)
|
||||
(and b (not (string=? cv "dot"))))
|
||||
true
|
||||
bd))
|
||||
|
||||
|
||||
;;-------------------------------------------------------------------------------------
|
||||
;;-------------------------------------------------------------------------------------
|
||||
;;-------------------------------------------------------------------------------------
|
||||
;; to-draw handler:
|
||||
|
||||
|
||||
;; GameState -> Image
|
||||
;; draws the game
|
||||
(define (render gs)
|
||||
(render-pm (gs-pm gs)
|
||||
(render-score (gs-score gs)
|
||||
(gs-board-image gs))))
|
||||
|
||||
;; Board -> Image
|
||||
;; draws the board
|
||||
(define (render-board bd)
|
||||
(foldr-board (lambda (x y cv b)
|
||||
(place-cell-image (cell-image cv) x y b))
|
||||
MTB
|
||||
bd))
|
||||
|
||||
;; Sprite Image -> Image
|
||||
;; adds pac-man image to img
|
||||
(define (render-pm pm img)
|
||||
(place-cell-image PM (sprite-x pm) (sprite-y pm) img))
|
||||
|
||||
;; Score Image -> Image
|
||||
;; adds score to img
|
||||
(define (render-score score img)
|
||||
(local [(define score-text
|
||||
(text (string-append "Score: " (number->string score)) SCORE-TEXT-SIZE "black"))]
|
||||
(place-image score-text
|
||||
(/ BOARD-WIDTH 2)
|
||||
BOARD-HEIGHT
|
||||
img)))
|
||||
|
||||
;; CellValue -> Image
|
||||
;; draws a board cell
|
||||
(define (cell-image cv)
|
||||
(cond [(string=? cv "empty") MTC]
|
||||
[(string=? cv "dot") DTC]
|
||||
[(string=? cv "wall") WALL]))
|
||||
|
||||
|
||||
;;-------------------------------------------------------------------------------------
|
||||
;;-------------------------------------------------------------------------------------
|
||||
;;-------------------------------------------------------------------------------------
|
||||
;; Operations on Board and other helpers:
|
||||
|
||||
|
||||
;; Board Natural Natural -> CellValue
|
||||
;; looks up the value of a Board cell
|
||||
(define (board-ref bd x y)
|
||||
(vector-ref (vector-ref bd y) x))
|
||||
|
||||
|
||||
(define (build-vector n f)
|
||||
(let ([vec (make-vector n)])
|
||||
(let loop ([i 0])
|
||||
(cond
|
||||
[(< i n)
|
||||
(vector-set! vec i (f i))
|
||||
(loop (add1 i))]))
|
||||
vec))
|
||||
|
||||
|
||||
;; (Natural Natural CellValue -> CellValue) Board -> Board
|
||||
;; the analogue of map for boards, the function is called for
|
||||
;; each position in the board to produce a cell value for that
|
||||
;; position in a new resulting board
|
||||
(define (map-board fn bd)
|
||||
(build-vector (vector-length bd)
|
||||
(lambda (y)
|
||||
(build-vector (vector-length (vector-ref bd y))
|
||||
(lambda (x)
|
||||
(fn x y (board-ref bd x y)))))))
|
||||
|
||||
;; (Natural Natural CellValue X -> X) X Board -> X
|
||||
;; the analogue of foldr for boards, the function is called for
|
||||
;; each position in the board to produce single value
|
||||
(define (foldr-board fn base bd)
|
||||
(local [(define nrows (vector-length bd))
|
||||
(define ncols (vector-length (vector-ref bd 0)))
|
||||
|
||||
(define (rows y b)
|
||||
(cond [(= y nrows) b]
|
||||
[else
|
||||
(rows (add1 y)
|
||||
(cols 0 y b))]))
|
||||
(define (cols x y b)
|
||||
(cond [(= x ncols) b]
|
||||
[else
|
||||
(cols (add1 x)
|
||||
y
|
||||
(fn x y (board-ref bd x y) b))]))]
|
||||
(rows 0 base)))
|
||||
|
||||
;; Image Natural Natural Image -> Image
|
||||
;; adds cell-img to board-image at x, y board coordinates
|
||||
(define (place-cell-image cell-img x y board-image)
|
||||
(place-image cell-img
|
||||
(+ (* x CELL-SIZE) (/ CELL-SIZE 2))
|
||||
(+ (* y CELL-SIZE) (/ CELL-SIZE 2))
|
||||
board-image))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
;; -> GameState
|
||||
;; runs the game
|
||||
(local [(define INIT-GS (make-gs INIT-PM
|
||||
INIT-BOARD
|
||||
(render-board INIT-BOARD)
|
||||
INIT-SCORE))]
|
||||
(big-bang INIT-GS
|
||||
(on-tick tick 0.3)
|
||||
(to-draw render)
|
||||
(on-key key-handler)
|
||||
;;(on-tilt tilt-handler)
|
||||
(stop-when game-over?)))
|
||||
56736
racketcon/pacman.xhtml
Normal file
56736
racketcon/pacman.xhtml
Normal file
File diff suppressed because one or more lines are too long
128
racketcon/rain.rkt
Normal file
128
racketcon/rain.rkt
Normal file
|
|
@ -0,0 +1,128 @@
|
|||
#lang planet dyoo/whalesong
|
||||
|
||||
(require (planet dyoo/whalesong/world))
|
||||
|
||||
|
||||
;; Rain falls down the screen.
|
||||
(define WIDTH 640)
|
||||
(define HEIGHT 480)
|
||||
|
||||
(define GRAVITY-FACTOR 1)
|
||||
(define BACKGROUND (empty-scene WIDTH HEIGHT))
|
||||
|
||||
|
||||
|
||||
(define-struct posn (x y))
|
||||
|
||||
|
||||
;; A drop particle describes where it is on screen, what color it is, and
|
||||
;; how large it is.
|
||||
(define-struct drop (posn velocity color size))
|
||||
|
||||
;; random-drop-particle: drop
|
||||
;; Generates a random particle.
|
||||
(define (random-drop)
|
||||
(make-drop (make-posn (random WIDTH) 0)
|
||||
(+ 5 (random 10)) ;; Get it falling at some random velocity
|
||||
(random-choice (list "gray" "darkgray"
|
||||
"white" "blue"
|
||||
"lightblue"
|
||||
"darkblue"))
|
||||
(random 10) ;; with some random size
|
||||
))
|
||||
|
||||
;; random-choice: (listof X) -> X
|
||||
;; Picks a random element of elts.
|
||||
(define (random-choice elts)
|
||||
(list-ref elts (random (length elts))))
|
||||
|
||||
|
||||
|
||||
;; The world consists of all of the drops in the sky.
|
||||
(define-struct world (sky ;; listof drop
|
||||
))
|
||||
|
||||
|
||||
|
||||
(define (my-filter f l)
|
||||
(cond
|
||||
[(null? l)
|
||||
'()]
|
||||
[(f (car l))
|
||||
(cons (car l)
|
||||
(my-filter f (cdr l)))]
|
||||
[else
|
||||
(my-filter f (cdr l))]))
|
||||
|
||||
|
||||
;; tick: world -> world
|
||||
(define (tick w)
|
||||
(make-world
|
||||
(my-filter not-on-floor?
|
||||
(map drop-descend (cons (random-drop)
|
||||
(cons (random-drop)
|
||||
(world-sky w)))))))
|
||||
|
||||
|
||||
;; drop-descend: drop -> drop
|
||||
;; Makes the drops descend.
|
||||
(define (drop-descend a-drop)
|
||||
(cond
|
||||
[(> (posn-y (drop-posn a-drop)) HEIGHT)
|
||||
a-drop]
|
||||
[else
|
||||
(make-drop (posn-descend (drop-posn a-drop) (drop-velocity a-drop))
|
||||
(+ GRAVITY-FACTOR (drop-velocity a-drop))
|
||||
(drop-color a-drop)
|
||||
(drop-size a-drop))]))
|
||||
|
||||
|
||||
;; posn-descend: posn number -> posn
|
||||
(define (posn-descend a-posn n)
|
||||
(make-posn (posn-x a-posn)
|
||||
(+ n (posn-y a-posn))))
|
||||
|
||||
|
||||
;; on-floor?: drop -> boolean
|
||||
;; Produces true if the drop has fallen to the floor.
|
||||
(define (on-floor? a-drop)
|
||||
(> (posn-y (drop-posn a-drop))
|
||||
HEIGHT))
|
||||
|
||||
(define (not-on-floor? a-drop) (not (on-floor? a-drop)))
|
||||
|
||||
;; make-drop-image: color number -> drop
|
||||
;; Creates an image of the drop particle.
|
||||
(define (make-drop-image color size)
|
||||
(circle size "solid" color))
|
||||
|
||||
|
||||
;; place-drop: drop scene -> scene
|
||||
(define (place-drop a-drop a-scene)
|
||||
(place-image (make-drop-image (drop-color a-drop)
|
||||
(drop-size a-drop))
|
||||
(posn-x (drop-posn a-drop))
|
||||
(posn-y (drop-posn a-drop))
|
||||
a-scene))
|
||||
|
||||
|
||||
|
||||
(define (my-foldl f acc lst)
|
||||
(cond
|
||||
[(null? lst)
|
||||
acc]
|
||||
[else
|
||||
(my-foldl f
|
||||
(f (car lst) acc)
|
||||
(cdr lst))]))
|
||||
|
||||
|
||||
;; draw: world -> scene
|
||||
(define (draw w)
|
||||
(my-foldl place-drop BACKGROUND (world-sky w)))
|
||||
|
||||
|
||||
|
||||
(big-bang (make-world '())
|
||||
(to-draw draw)
|
||||
(on-tick tick))
|
||||
43033
racketcon/rain.xhtml
Normal file
43033
racketcon/rain.xhtml
Normal file
File diff suppressed because it is too large
Load Diff
71
racketcon/talk.rkt
Normal file
71
racketcon/talk.rkt
Normal file
|
|
@ -0,0 +1,71 @@
|
|||
#lang planet dyoo/whalesong
|
||||
|
||||
(require (planet dyoo/whalesong/js))
|
||||
(require (planet dyoo/whalesong/world))
|
||||
|
||||
;; A slide is either a simple string or an image.
|
||||
|
||||
|
||||
(define slides
|
||||
(list "Whalesong: a Racket to JavaScript Compiler"
|
||||
"Why Whalesong?"
|
||||
"World programs on the web"
|
||||
"Reusing Racket..."
|
||||
"Hello world!"
|
||||
"What's missing?"
|
||||
"http://hashcollision.org/whalesong"))
|
||||
|
||||
|
||||
|
||||
|
||||
(define (WIDTH)
|
||||
(viewport-width))
|
||||
|
||||
(define (HEIGHT)
|
||||
(viewport-height))
|
||||
|
||||
(define (BACKGROUND)
|
||||
(empty-scene (WIDTH) (HEIGHT)))
|
||||
|
||||
|
||||
(define (key w a-key)
|
||||
(cond
|
||||
[(key=? a-key "left")
|
||||
(my-max (sub1 w) 0)]
|
||||
[(key=? a-key "right")
|
||||
(my-min (sub1 w) (length slides))]
|
||||
[else w]))
|
||||
|
||||
|
||||
(define (draw w)
|
||||
(let ([a-slide (list-ref slides w)]
|
||||
[bg (BACKGROUND)])
|
||||
(cond
|
||||
[(string? a-slide)
|
||||
(place-image (text a-slide 300 "black")
|
||||
(quotient (image-width bg) 2)
|
||||
(quotient (image-height bg) 2)
|
||||
bg)]
|
||||
|
||||
[(image? a-slide)
|
||||
(place-image a-slide
|
||||
(quotient (image-width bg) 2)
|
||||
(quotient (image-height bg) 2)
|
||||
bg)])))
|
||||
|
||||
|
||||
(define (my-max x y)
|
||||
(if (> x y)
|
||||
x
|
||||
y))
|
||||
|
||||
(define (my-min x y)
|
||||
(if (< x y)
|
||||
x
|
||||
y))
|
||||
|
||||
|
||||
|
||||
(big-bang 0
|
||||
(on-key key)
|
||||
(on-draw draw))
|
||||
Loading…
Reference in New Issue
Block a user