From 2eb571ef246c1f3c7fec8f8349b908bb19190f15 Mon Sep 17 00:00:00 2001 From: Danny Yoo Date: Fri, 8 Jul 2011 17:27:19 -0400 Subject: [PATCH] getting minimal set of values we need from the image library to run our image exercise --- examples/image-library-example.rkt | 2 +- examples/image-program.rkt | 9 ---- image/private/color.rkt | 11 +++- image/private/js-impl.js | 4 +- image/private/main.rkt | 52 +++++++++++++++++- image/private/racket-impl.rkt | 84 ++++++++++++++++++++++++++++- js-assembler/runtime-src/runtime.js | 9 ++++ lang/kernel.rkt | 4 +- 8 files changed, 157 insertions(+), 18 deletions(-) delete mode 100644 examples/image-program.rkt diff --git a/examples/image-library-example.rkt b/examples/image-library-example.rkt index b11436c..e813c94 100644 --- a/examples/image-library-example.rkt +++ b/examples/image-library-example.rkt @@ -47,7 +47,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; "simple text functionality" (text "hello world" 20 'black) -(text (string-copy "hello world") 30 'purple) +(text "hello world" 30 'purple) (text "hello world" 40 'red) diff --git a/examples/image-program.rkt b/examples/image-program.rkt deleted file mode 100644 index 99edd27..0000000 --- a/examples/image-program.rkt +++ /dev/null @@ -1,9 +0,0 @@ -#lang planet dyoo/whalesong -(require (planet dyoo/whalesong/image)) - -(is-color? "red") -(is-color? "blue") -(is-color? 42) - -(is-color? (make-color 3 4 5 0)) -(is-color? "color") diff --git a/image/private/color.rkt b/image/private/color.rkt index 236971b..077f23d 100644 --- a/image/private/color.rkt +++ b/image/private/color.rkt @@ -1,6 +1,15 @@ #lang s-exp "../../lang/base.rkt" -(provide [struct-out color]) +(provide (except-out [struct-out color] color make-color) + [rename-out [-color make-color] + [-color color]]) (define-struct color (red green blue alpha) #:extra-constructor-name make-color) + +(define -color + (case-lambda + [(r g b) + (color r g b 255)] + [(r g b a) + (color r g b a)])) \ No newline at end of file diff --git a/image/private/js-impl.js b/image/private/js-impl.js index cbb2bb9..ad69639 100644 --- a/image/private/js-impl.js +++ b/image/private/js-impl.js @@ -1,6 +1,6 @@ -EXPORTS['is-color?'] = +EXPORTS['image-color?'] = plt.runtime.makePrimitiveProcedure( - 'is-color?', + 'image-color?', 1, function(MACHINE) { var elt = MACHINE.env[MACHINE.env.length - 1]; diff --git a/image/private/main.rkt b/image/private/main.rkt index 6cd68c0..d7423df 100644 --- a/image/private/main.rkt +++ b/image/private/main.rkt @@ -10,6 +10,56 @@ #:javascript ("colordb.js" "kernel.js" "js-impl.js") - #:provided-values (is-color?)) + #:provided-values (text + text/font + image-url + open-image-url + overlay + overlay/xy + overlay/align + underlay + underlay/xy + underlay/align + beside + beside/align + above + above/align + place-image/align + rotate + scale + scale/xy + flip-horizontal + flip-vertical + frame + crop + line + add-line + scene+line + circle + square + rectangle + regular-polygon + ellipse + triangle + right-triangle + isosceles-triangle + star + radial-star + star-polygon + rhombus + image->color-list + color-list->image + image-width + image-height + image-baseline + image-color? + mode? + x-place? + y-place? + angle? + side-count? + step-count? + + )) diff --git a/image/private/racket-impl.rkt b/image/private/racket-impl.rkt index 1277be7..9be555a 100644 --- a/image/private/racket-impl.rkt +++ b/image/private/racket-impl.rkt @@ -1,6 +1,86 @@ #lang s-exp "../../lang/base.rkt" -(provide is-color?) +(require 2htdp/image + (for-syntax racket/base)) + +(provide text + text/font + image-url + open-image-url + overlay + overlay/xy + overlay/align + underlay + underlay/xy + underlay/align + beside + beside/align + above + above/align + place-image/align + rotate + scale + scale/xy + flip-horizontal + flip-vertical + frame + crop + line + add-line + scene+line + circle + square + rectangle + regular-polygon + ellipse + triangle + right-triangle + isosceles-triangle + star + radial-star + star-polygon + rhombus + image->color-list + color-list->image + image-width + image-height + image-baseline + image-color? + mode? + x-place? + y-place? + angle? + side-count? + + ;; 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? + ) (define (is-color? x) - true) \ No newline at end of file + true) + + + +(define-syntax (define-stubs stx) + (syntax-case stx () + [(_ f ...) + (syntax/loc stx + (begin + (define f (lambda args (error 'f))) ...))])) + + + +(define-stubs + image-url + open-image-url + color-list->image + ) + + + +(define (my-step-count? x) + (and (integer? x) + (>= x 1))) + +(provide (rename-out [my-step-count? step-count?])) \ No newline at end of file diff --git a/js-assembler/runtime-src/runtime.js b/js-assembler/runtime-src/runtime.js index 6ec85dd..f094ba1 100644 --- a/js-assembler/runtime-src/runtime.js +++ b/js-assembler/runtime-src/runtime.js @@ -1609,6 +1609,15 @@ if(this['plt'] === undefined) { this['plt'] = {}; } }); + installPrimitiveProcedure( + 'integer?', + 1, + function(MACHINE) { + return plt.baselib.numbers.isInteger(MACHINE.env[MACHINE.env.length - 1]); + }); + + + installPrimitiveProcedure( 'imag-part', 1, diff --git a/lang/kernel.rkt b/lang/kernel.rkt index 9a2da14..73a9661 100644 --- a/lang/kernel.rkt +++ b/lang/kernel.rkt @@ -263,8 +263,8 @@ vector? ;; complex? ;; real? ;; rational? -;; integer? - exact? +integer? +exact? ;; inexact? ;; odd? ;; even?