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

Move graphics-posn-less to lang racket

Browse Source 
-write a macro to convert rec uses to Racket's letrec.
-remove opt-lambdas in favor of Racket's lambda.
This commit is contained in:
Patrick Mahoney 2012-08-14 20:31:37 -04:00 committed by Gregory Cooper
parent 5ec59b1793
commit d1d7bdf5f9
1 changed files with 13 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
collects/frtime/animation/graphics-posn-less-unit.rkt
View File

@ -7,14 +7,21 @@
(require mred/mred-sig (require mred/mred-sig
racket/class racket/class
mzlib/etc (for-syntax syntax/parse racket/base)
frtime/core/frp frtime/core/frp
"graphics-sig.rkt") "graphics-sig.rkt")
(import (prefix mred: mred^) (import (prefix mred: mred^)
graphics:posn^) graphics:posn^)
(export graphics:posn-less^) (export graphics:posn-less^)
(define-syntax (rec stx)
(syntax-parse stx
[((~literal rec) var:identifier rhs:expr)
#'(letrec ([var rhs])
var)]))
(define send/proc (define send/proc
(lambda (class method . args) (lambda (class method . args)
(send-generic class (make-generic mred:dc<%> method) . args))) (send-generic class (make-generic mred:dc<%> method) . args)))
@ -961,7 +968,7 @@
c))) c)))
(define draw-pixmap-posn (define draw-pixmap-posn
(opt-lambda (filename [type 'unknown/mask]) (lambda (filename [type 'unknown/mask])
(check 'draw-pixmap-posn (check 'draw-pixmap-posn
string? filename "filename" string? filename "filename"
(lambda (x) (memq x '(gif xbm xpm bmp pict unknown unknown/mask gif/mask))) type "file type symbol") (lambda (x) (memq x '(gif xbm xpm bmp pict unknown unknown/mask gif/mask))) type "file type symbol")
@ -969,7 +976,7 @@
(lambda (viewport) (lambda (viewport)
(check 'draw-pixmap-posn (check 'draw-pixmap-posn
viewport? viewport "viewport") viewport? viewport "viewport")
(opt-lambda (posn [color #f]) (lambda (posn [color #f])
(check 'draw-pixmap-posn (check 'draw-pixmap-posn
posn? posn "posn" posn? posn "posn"
(orp not color?) color (format "color or ~e" #f)) (orp not color?) color (format "color or ~e" #f))
@ -984,7 +991,7 @@
(lambda (viewport) (lambda (viewport)
(check 'draw-pixmap (check 'draw-pixmap
viewport? viewport "viewport") viewport? viewport "viewport")
(opt-lambda (filename p [color #f]) (lambda (filename p [color #f])
(check 'draw-pixmap (check 'draw-pixmap
(andp string? file-exists?) filename "filename" (andp string? file-exists?) filename "filename"
posn? p "posn" posn? p "posn"
@ -1006,7 +1013,7 @@
(lambda (viewport) (lambda (viewport)
(check 'save-pixmap (check 'save-pixmap
viewport? viewport "viewport") viewport? viewport "viewport")
(opt-lambda (filename [kind 'xpm]) (lambda (filename [kind 'xpm])
(check 'save-pixmap (check 'save-pixmap
(andp string? (orp relative-path? absolute-path?)) filename "filename" (andp string? (orp relative-path? absolute-path?)) filename "filename"
(lambda (x) (memq x '(xpm xbm bmp pict))) kind "file type symbol") (lambda (x) (memq x '(xpm xbm bmp pict))) kind "file type symbol")