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

Require racket/match instead of mzlib/match

Browse Source 
match pattern changes:
($ struct-id ...) -> (struct-id ...)
(hd tl) -> (list hd tl)
-small provide cleanup in lang-utils.rkt
This commit is contained in:
Patrick Mahoney 2012-08-03 19:44:58 -04:00 committed by Gregory Cooper
parent 01ec2d3fde
commit 21fcc4934c
2 changed files with 16 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
collects/frtime/animation.rkt
View File

@ -4,7 +4,7 @@
make-posn posn-x posn-y make-rgb) make-posn posn-x posn-y make-rgb)
(lifted frtime/animation/graphics (lifted frtime/animation/graphics
posn-x posn-y make-posn make-rgb) posn-x posn-y make-posn make-rgb)
mzlib/match racket/match
(as-is:unchecked frtime/lang-ext lift) (as-is:unchecked frtime/lang-ext lift)
racket/class racket/class
frtime/frlibs/list frtime/frlibs/list
@ -136,7 +136,7 @@
(lambda (v) (lambda (v)
(match (v-n v) (match (v-n v)
[(? undefined?) (void)] [(? undefined?) (void)]
[($ ring center radius color) [(ring center radius color)
(let ([center (v-n center)] (let ([center (v-n center)]
[radius (v-n radius)] [radius (v-n radius)]
[color (v-n color)]) [color (v-n color)])
@ -148,25 +148,25 @@
(* 2 radius) (* 2 radius)
(* 2 radius) (* 2 radius)
(if (undefined? color) "black" color))))] (if (undefined? color) "black" color))))]
[($ arc pos width height start-radians end-radians color) [(arc pos width height start-radians end-radians color)
(let ([pos (v-n pos)] (let ([pos (v-n pos)]
[width (v-n width)] [width (v-n width)]
[height (v-n height)] [height (v-n height)]
[start-radians (v-n start-radians)] [start-radians (v-n start-radians)]
[end-radians (v-n end-radians)]) [end-radians (v-n end-radians)])
((draw-arc pixmap) pos width height start-radians end-radians color))] ((draw-arc pixmap) pos width height start-radians end-radians color))]
[($ solid-arc pos width height start-radians end-radians color) [(solid-arc pos width height start-radians end-radians color)
(let ([pos (v-n pos)] (let ([pos (v-n pos)]
[width (v-n width)] [width (v-n width)]
[height (v-n height)] [height (v-n height)]
[start-radians (v-n start-radians)] [start-radians (v-n start-radians)]
[end-radians (v-n end-radians)]) [end-radians (v-n end-radians)])
((draw-solid-arc pixmap) pos width height start-radians end-radians color))] ((draw-solid-arc pixmap) pos width height start-radians end-radians color))]
[($ image pos renderer) [(image pos renderer)
(let ([renderer (v-n renderer)] (let ([renderer (v-n renderer)]
[pos (v-n pos)]) [pos (v-n pos)])
((renderer pixmap) pos))] ((renderer pixmap) pos))]
[($ solid-ellipse ul w h color) [(solid-ellipse ul w h color)
(let ([ul (v-n ul)] (let ([ul (v-n ul)]
[w (v-n w)] [w (v-n w)]
[h (v-n h)] [h (v-n h)]
@ -175,15 +175,15 @@
(undefined? w) (undefined? w)
(undefined? h)) (undefined? h))
((draw-solid-ellipse pixmap) ul w h (if (undefined? color) "black" color))))] ((draw-solid-ellipse pixmap) ul w h (if (undefined? color) "black" color))))]
[($ graph-string pos text color) ((draw-string pixmap) (v-n pos) (v-n text) (v-n color))] [(graph-string pos text color) ((draw-string pixmap) (v-n pos) (v-n text) (v-n color))]
[($ line p1 p2 color) [(line p1 p2 color)
(let ([p1 (v-n p1)] (let ([p1 (v-n p1)]
[p2 (v-n p2)] [p2 (v-n p2)]
[color (v-n color)]) [color (v-n color)])
(unless (or (undefined? p1) (unless (or (undefined? p1)
(undefined? p2)) (undefined? p2))
((draw-line pixmap) p1 p2 (if (undefined? color) "black" color))))] ((draw-line pixmap) p1 p2 (if (undefined? color) "black" color))))]
[($ rect ul w h color) [(rect ul w h color)
(let ([ul (v-n ul)] (let ([ul (v-n ul)]
[w (v-n w)] [w (v-n w)]
[h (v-n h)] [h (v-n h)]
@ -193,8 +193,8 @@
[(>= h 0) ((draw-solid-rectangle pixmap) (make-posn (+ (posn-x ul) w) (posn-y ul)) (- w) h color)] [(>= h 0) ((draw-solid-rectangle pixmap) (make-posn (+ (posn-x ul) w) (posn-y ul)) (- w) h color)]
[(>= w 0) ((draw-solid-rectangle pixmap) (make-posn (posn-x ul) (+ (posn-y ul) h)) w (- h) color)] [(>= w 0) ((draw-solid-rectangle pixmap) (make-posn (posn-x ul) (+ (posn-y ul) h)) w (- h) color)]
[else ((draw-solid-rectangle pixmap) (make-posn (+ (posn-x ul) w) (+ (posn-y ul) h)) (- w) (- h) color)]))] [else ((draw-solid-rectangle pixmap) (make-posn (+ (posn-x ul) w) (+ (posn-y ul) h)) (- w) (- h) color)]))]
[($ polygon pts offset color) ((draw-polygon pixmap) pts offset color)] [(polygon pts offset color) ((draw-polygon pixmap) pts offset color)]
[($ solid-polygon pts offset color) ((draw-solid-polygon pixmap) pts offset color)] [(solid-polygon pts offset color) ((draw-solid-polygon pixmap) pts offset color)]
[(? list? x) (loop (v-n x))] [(? list? x) (loop (v-n x))]
[(? void?) (void)])) [(? void?) (void)]))
a-los v-n))) a-los v-n)))
@ -206,7 +206,7 @@
(define (draw-graph-color pm gc) (define (draw-graph-color pm gc)
(let ([dp (draw-pixel pm)]) (let ([dp (draw-pixel pm)])
(match gc (match gc
[($ graph-color fn xmin xmax ymin ymax) [(graph-color fn xmin xmax ymin ymax)
(let ([xincr (/ (- xmax xmin) 300)] (let ([xincr (/ (- xmax xmin) 300)]
[yincr (/ (- ymax ymin) 300)]) [yincr (/ (- ymax ymin) 300)])
(let loop ([i 50] [y ymin]) (let loop ([i 50] [y ymin])
@ -301,9 +301,9 @@
(make-wave-state (value-now hz) 0) (make-wave-state (value-now hz) 0)
(lambda (new-freq+time old-state) (lambda (new-freq+time old-state)
(match new-freq+time (match new-freq+time
[(h1 t) [(list h1 t)
(match old-state (match old-state
[($ wave-state h0 o0) [(wave-state h0 o0)
(make-wave-state (make-wave-state
h1 h1
(+ o0 (* .002 pi t (- h0 h1))))])])))]) (+ o0 (* .002 pi t (- h0 h1))))])])))])

8
collects/frtime/lang-utils.rkt
View File

@ -62,7 +62,7 @@
(only frtime/core/frp super-lift behavior? value-now) (only frtime/core/frp super-lift behavior? value-now)
(rename "lang-ext.rkt" undefined undefined) (rename "lang-ext.rkt" undefined undefined)
(rename "lang-ext.rkt" undefined? undefined?) (rename "lang-ext.rkt" undefined? undefined?)
mzlib/class) racket/class)
(require (only racket/list empty)) (require (only racket/list empty))
(define-syntax (lifted-send stx) (define-syntax (lifted-send stx)
@ -399,11 +399,7 @@
read-case-sensitive read-case-sensitive
file-exists? file-exists?
with-input-from-file with-input-from-file
read read)
)
; from core ; from core
(provide (all-from "lang-core.rkt")) (provide (all-from "lang-core.rkt"))