suzanne.soy/whalesong
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge commit 'origin/racketcon'

Browse Source
This commit is contained in:
Danny Yoo 2011-07-27 12:59:46 -04:00
commit 1168f2133f
18 changed files with 142552 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
image/private/js-impl.js
View File

@ -79,6 +79,12 @@ var checkReal = plt.baselib.check.checkReal;
var checkBoolean = plt.baselib.check.checkBoolean; var checkBoolean = plt.baselib.check.checkBoolean;
var checkNatural = plt.baselib.check.checkNatural; var checkNatural = plt.baselib.check.checkNatural;
var checkPositiveInteger = plt.baselib.check.makeCheckArgumentType(
function(x) { return plt.baselib.numbers.isInteger(x) &&
plt.baselib.numbers.greaterThan(x, 0);},
"positive integer");
var checkNonNegativeReal = plt.baselib.check.checkNonNegativeReal; var checkNonNegativeReal = plt.baselib.check.checkNonNegativeReal;
@ -220,6 +226,15 @@ EXPORTS['step-count?'] =
}); });
EXPORTS['image?'] =
makePrimitiveProcedure(
'image?',
1,
function(MACHINE) {
return isImage(MACHINE.env[MACHINE.env.length - 1]);
});
EXPORTS['text'] = EXPORTS['text'] =
makePrimitiveProcedure( makePrimitiveProcedure(
@ -227,7 +242,8 @@ EXPORTS['text'] =
3, 3,
function(MACHINE) { function(MACHINE) {
var aString = checkString(MACHINE,'text', 0); var aString = checkString(MACHINE,'text', 0);
var aSize = checkByte(MACHINE, 'text', 1); // Unlike 2htdp, we'll allow this to be a positive integer
var aSize = checkPositiveInteger(MACHINE, 'text', 1);
var aColor = checkColor(MACHINE, 'text', 2); var aColor = checkColor(MACHINE, 'text', 2);
return makeTextImage(aString.toString(), return makeTextImage(aString.toString(),
jsnums.toFixnum(aSize), jsnums.toFixnum(aSize),

2
image/private/main.rkt
View File

@ -61,6 +61,8 @@
angle? angle?
side-count? side-count?
step-count? step-count?
image?
)) ))

3
image/private/racket-impl.rkt
View File

@ -55,6 +55,9 @@
side-count? side-count?
image-color? image-color?
image?
;; Something funky is happening on the Racket side of things with regards ;; 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 ;; to step-count? See: http://bugs.racket-lang.org/query/?cmd=view&pr=12031
;; step-count? ;; step-count?

7
js-assembler/runtime-src/runtime.js
View File

@ -1352,6 +1352,13 @@ if(this['plt'] === undefined) { this['plt'] = {}; }
}); });
installPrimitiveProcedure(
'string?',
1,
function(MACHINE) {
return isString(MACHINE.env[MACHINE.env.length - 1]);
});
installPrimitiveProcedure( installPrimitiveProcedure(
'exact?', 'exact?',
1, 1,

2
lang/kernel.rkt
View File

@ -255,7 +255,7 @@ error
;; immutable? ;; immutable?
;; void? ;; void?
symbol? symbol?
;; string? string?
;; char? ;; char?
;; boolean? ;; boolean?
vector? vector?

4
racketcon/Makefile Normal file
View File

@ -0,0 +1,4 @@
all:
../whalesong build talk.rkt
../whalesong get-javascript --verbose fact.rkt > fact.js
../whalesong get-runtime --verbose > runtime.js

BIN
racketcon/bootstrap.gif Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 7.2 KiB

32
racketcon/fact.html Normal file
View File

@ -0,0 +1,32 @@
<html>
<head>
<script src="runtime.js"></script>
<script src="fact.js"></script>
<script>
plt.runtime.invokeMains();
plt.runtime.ready(function() {
var myFactClosure = plt.runtime.lookupInMains('fact');
var myFact = plt.baselib.functions.asJavaScriptFunction(
myFactClosure);
myFact(function(v) {
$('#answer').text('computed. Printing...');
setTimeout(function() { $('#answer').text(v.toString()); }, 0);
},
function(err) {
$('#answer').text(err.message).css("color", "red");
},
10000
// "one-billion-dollars"
);
});
</script>
</head>
<body>
The factorial of 10000 is <span id="answer">being computed</span>.
</body>
</html>

8
racketcon/fact.rkt Normal file
View File

@ -0,0 +1,8 @@
#lang planet dyoo/whalesong
(provide fact)
(define (fact x)
(cond
[(= x 0)
1]
[else
(* x (fact (sub1 x)))]))

23
racketcon/hello.rkt Normal file
View 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
View File

File diff suppressed because it is too large Load Diff

450
racketcon/pacman.rkt Normal file
View 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
View File

File diff suppressed because one or more lines are too long

BIN
racketcon/plt-logo.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 6.6 KiB

58
racketcon/racket-days-abstract.txt Normal file
View File

@ -0,0 +1,58 @@
What's Whalesong? It's a Racket to JavaScript compiler. Whalesong
will be used to support World programming for the web. It will be the
evaluator for the upcoming versions of Moby Scheme, as well as
WeScheme.
We can support simple animations, as you'd expect:
(Show a world program: the falling rain drops program.)
We can do programs that have interactivity, such as:
(Show another world program: pacman.)
A core idea behind Whalesong is to reuse Racket's infrastructure as
much as possible. I'm not a compiler person, so I cheat, by
piggibacking on Matthew's work. Whalesong reuses the bytecode
compiler, and translates the bytecode to JavaScript.
I really am reusing the linguistic features of Racket. For example,
let's look at the less-than-impressive program output below.
(Show the hello world program)
This is trivial, right? Let's look at the source code.
(Reveal that the program was written in BF)
Yes, this is unholy, but it works. We really are using Racket's
underlying language features to handle reading, macro expansion, and
optimization.
Because we're on the web, we may even want to use functions that we've
written in Racket as a part of regular web pages. Whalesong lets us
do this.
(Show the factorial example, and how it can be used by external
JavaScript on a web page.)
There's quite a bit that's missing: we don't yet have all of the
primitives necessary to compile racket/base, so all Whalesong programs
currently have to be in a language that ultimately bottoms to (planet
dyoo/whalesong/lang/base).
I'm going to get a release out in the following month, and the new
versions of Moby Scheme for Smartphones, as well as the WeScheme
environment, will be using the underlying evaluator of Whalesong.
If you're interested, please talk to me during the break. Thanks!

128
racketcon/rain.rkt Normal file
View 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
View File

File diff suppressed because it is too large Load Diff

123
racketcon/talk.rkt Normal file
View File

@ -0,0 +1,123 @@
#lang planet dyoo/whalesong
(require (planet dyoo/whalesong/js))
(require (planet dyoo/whalesong/world))
(define-struct world (index scaling rotate))
;; A slide is either a simple string or an image.
(define font-size 50)
(define slides
(list
(above
(text "Whalesong:" 100 "black")
(text "a Racket to JavaScript Compiler" 80 "black")
(square 20 "solid" "white")
(scale 2 (image-url "file:///home/dyoo/work/whalesong/racketcon/plt-logo.png"))
(square 20 "solid" "white")
(text "Danny Yoo (dyoo@hashcollision.org)" 50 "darkblue"))
(above (text "Why Whalesong?" font-size "black")
(square 20 "solid" "white")
(scale 2 (image-url "file:///home/dyoo/work/whalesong/racketcon/bootstrap.gif")))
"World programs on the web"
(above (text "Reusing Racket's compiler..." font-size "black")
(square 20 "solid" "white")
(text "Hello world?" (floor (* font-size 2/3)) "black"))
"Web programs can use Racket too!"
"What's next?"
(text "http://hashcollision.org/whalesong" 80 "black")))
(define (WIDTH)
(viewport-width))
(define (HEIGHT)
(viewport-height))
(define (BACKGROUND)
(empty-scene (WIDTH) (HEIGHT)))
(define (key w a-key)
(cond
[(key=? a-key "left")
(make-world (my-max (sub1 (world-index w)) 0)
(world-scaling w)
(world-rotate w))]
[(or (key=? a-key "right") (key=? a-key " ") (key=? a-key "enter"))
(make-world (my-min (add1 (world-index w))
(sub1 (length slides)))
(world-scaling w)
(world-rotate w))]
[(key=? a-key "up")
(make-world (world-index w)
(+ (world-scaling w) .1)
(world-rotate w))]
[(key=? a-key "down")
(make-world (world-index w)
(- (world-scaling w) .1)
(world-rotate w))]
[(key=? a-key "r")
(make-world 0 1 0)]
[(key=? a-key "q")
(make-world (world-index w)
(world-scaling w)
(modulo (- (world-rotate w) 1) 360))]
[(key=? a-key "w")
(make-world (world-index w)
(world-scaling w)
(modulo (+ (world-rotate w) 1) 360))]
[else w]))
(define (draw w)
(rotate (world-rotate w)
(scale (world-scaling w)
(let ([a-slide (list-ref slides (world-index w))]
[bg (BACKGROUND)])
(cond
[(string? a-slide)
(place-image (text a-slide font-size "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 (tick w)
w)
(define (my-max x y)
(if (> x y)
x
y))
(define (my-min x y)
(if (< x y)
x
y))
(big-bang (make-world 0 1 0)
(on-key key)
(on-tick tick)
(to-draw draw))