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

adjust the teaching languages so they print images specially.

Browse Source 
I picked "#<image>" not because I think it is a good way to print,
  but just so that there is something there to be easily changed later,
  when someone who has an opinion decides to change it.
This commit is contained in:
Robby Findler 2011-07-19 13:08:58 -05:00
parent 2a78ea9723
commit 9595145d79
3 changed files with 96 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

78
collects/drracket/private/language.rkt
View File

@ -393,44 +393,50 @@
[pretty-print-columns width] [pretty-print-columns width]
[pretty-print-size-hook [pretty-print-size-hook
(λ (value display? port) (let ([oh (pretty-print-size-hook)])
(cond (λ (value display? port)
[(not (port-writes-special? port)) #f] (cond
[(is-a? value snip%) 1] [(not (port-writes-special? port)) (oh value display? port)]
[(use-number-snip? value) 1] [(is-a? value snip%) 1]
[(syntax? value) 1] [(use-number-snip? value) 1]
[(to-snip-value? value) 1] [(syntax? value) 1]
[else #f]))] [(to-snip-value? value) 1]
[else (oh value display? port)])))]
[pretty-print-print-hook [pretty-print-print-hook
(λ (value display? port) (let ([oh (pretty-print-print-hook)])
(cond (λ (value display? port)
[(image-core:image? value) (cond
[(not (port-writes-special? port)) (oh value display? port)]
[(is-a? value snip%)
(cond
[(image-core:image? value)
;; do this computation here so that any failures ;; do this computation here so that any failures
;; during drawing happen under the user's custodian ;; during drawing happen under the user's custodian
(image-core:compute-image-cache value) (image-core:compute-image-cache value)
(write-special value port)
(write-special value port) 1]
1] [else
[(is-a? value snip%) (write-special value port)
(write-special value port) 1])]
1] [(use-number-snip? value)
[(use-number-snip? value) (write-special
(write-special (case (simple-settings-fraction-style settings)
(case (simple-settings-fraction-style settings) [(mixed-fraction)
[(mixed-fraction) (number-snip:make-fraction-snip value #f)]
(number-snip:make-fraction-snip value #f)] [(mixed-fraction-e)
[(mixed-fraction-e) (number-snip:make-fraction-snip value #t)]
(number-snip:make-fraction-snip value #t)] [(repeating-decimal)
[(repeating-decimal) (number-snip:make-repeating-decimal-snip value #f)]
(number-snip:make-repeating-decimal-snip value #f)] [(repeating-decimal-e)
[(repeating-decimal-e) (number-snip:make-repeating-decimal-snip value #t)])
(number-snip:make-repeating-decimal-snip value #t)]) port)
port) 1]
1] [(syntax? value)
[(syntax? value) (write-special (render-syntax/snip value) port)]
(write-special (render-syntax/snip value) port)] [(to-snip-value? value)
[else (write-special (value->snip value) port)]))] (write-special (value->snip value) port)]
[else (oh value display? port)])))]
[print-graph [print-graph
;; only turn on print-graph when using `write' or `print' printing ;; only turn on print-graph when using `write' or `print' printing
;; style, because the sharing is being taken care of ;; style, because the sharing is being taken care of

34
collects/htdp/bsl/runtime.rkt
View File

@ -1,7 +1,10 @@
#lang racket/base #lang racket/base
(require mzlib/pconvert (require mzlib/pconvert
racket/pretty racket/pretty
lang/private/set-result) lang/private/set-result
mrlib/image-core
racket/snip
racket/class)
(provide configure) (provide configure)
@ -15,6 +18,7 @@
(lambda (val basic sub) (lambda (val basic sub)
(cond (cond
[(equal? val set!-result) '(void)] [(equal? val set!-result) '(void)]
[(is-image? val) val]
[else (ph val basic sub)])))) [else (ph val basic sub)]))))
(use-named/undefined-handler (use-named/undefined-handler
(lambda (x) (lambda (x)
@ -28,17 +32,41 @@
;; Set pretty-print options: ;; Set pretty-print options:
(pretty-print-show-inexactness #t) (pretty-print-show-inexactness #t)
(pretty-print-exact-as-decimal #t) (pretty-print-exact-as-decimal #t)
(define img-str "#<image>")
(define (is-image? val)
(or (is-a? val image%) ;; 2htdp/image
(is-a? val image-snip%))) ;; literal image constant
(show-sharing (memq 'show-sharing options)) (show-sharing (memq 'show-sharing options))
;; Set print handlers to use print-convert and pretty-write: ;; Set print handlers to use print-convert and pretty-write:
(define (set-handlers thunk)
(parameterize ([pretty-print-print-hook
(let ([oh (pretty-print-print-hook)])
(λ (val display? port)
(if (and (not (port-writes-special? port))
(is-image? val))
(begin (display img-str port)
(string-length img-str))
(oh val display? port))))]
[pretty-print-size-hook
(let ([oh (pretty-print-size-hook)])
(λ (val display? port)
(if (and (not (port-writes-special? port))
(is-image? val))
(string-length img-str)
(oh val display? port))))])
(thunk)))
(current-print (current-print
(lambda (v) (lambda (v)
(unless (void? v) (unless (void? v)
(pretty-write (print-convert v))))) (define converted (print-convert v))
(set-handlers
(λ () (pretty-write converted))))))
(let ([orig (global-port-print-handler)]) (let ([orig (global-port-print-handler)])
(global-port-print-handler (global-port-print-handler
(lambda (val port [depth 0]) (lambda (val port [depth 0])
(parameterize ([global-port-print-handler orig]) (parameterize ([global-port-print-handler orig])
(let ([val (print-convert val)]) (let ([val (print-convert val)])
(parameterize ([pretty-print-columns 'infinity]) (parameterize ([pretty-print-columns 'infinity])
(pretty-write val port)))))))) (set-handlers
(λ () (pretty-write val port))))))))))

22
collects/lang/htdp-langs.rkt
View File

@ -16,6 +16,7 @@
framework/private/bday framework/private/bday
syntax/moddep syntax/moddep
mrlib/cache-image-snip mrlib/cache-image-snip
(prefix-in ic: mrlib/image-core)
setup/dirs setup/dirs
test-engine/racket-tests test-engine/racket-tests
@ -192,6 +193,12 @@
;; set-printing-parameters : settings ( -> TST) -> TST ;; set-printing-parameters : settings ( -> TST) -> TST
;; is implicitly exposed to the stepper. watch out! -- john ;; is implicitly exposed to the stepper. watch out! -- john
(define/public (set-printing-parameters settings thunk) (define/public (set-printing-parameters settings thunk)
(define img-str "#<image>")
(define (is-image? val)
(or (is-a? val ic:image%) ;; 2htdp/image
(is-a? val cache-image-snip%) ;; htdp/image
(is-a? val image-snip%) ;; literal image constant
(is-a? val bitmap%))) ;; works in other places, so include it here too
(parameterize ([pc:booleans-as-true/false #t] (parameterize ([pc:booleans-as-true/false #t]
[pc:abbreviate-cons-as-list (get-abbreviate-cons-as-list)] [pc:abbreviate-cons-as-list (get-abbreviate-cons-as-list)]
[pc:current-print-convert-hook [pc:current-print-convert-hook
@ -202,6 +209,21 @@
[else (ph val basic sub)])))] [else (ph val basic sub)])))]
[pretty-print-show-inexactness #t] [pretty-print-show-inexactness #t]
[pretty-print-exact-as-decimal #t] [pretty-print-exact-as-decimal #t]
[pretty-print-print-hook
(let ([oh (pretty-print-print-hook)])
(λ (val display? port)
(if (and (not (port-writes-special? port))
(is-image? val))
(begin (display img-str port)
(string-length img-str))
(oh val display? port))))]
[pretty-print-size-hook
(let ([oh (pretty-print-size-hook)])
(λ (val display? port)
(if (and (not (port-writes-special? port))
(is-image? val))
(string-length img-str)
(oh val display? port))))]
[pc:use-named/undefined-handler [pc:use-named/undefined-handler
(lambda (x) (lambda (x)
(and (get-use-function-output-syntax?) (and (get-use-function-output-syntax?)