From 9595145d79c269aeec73dea91e20baac359e0e33 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Tue, 19 Jul 2011 13:08:58 -0500 Subject: [PATCH] adjust the teaching languages so they print images specially. I picked "#" 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. --- collects/drracket/private/language.rkt | 80 ++++++++++++++------------ collects/htdp/bsl/runtime.rkt | 34 ++++++++++- collects/lang/htdp-langs.rkt | 22 +++++++ 3 files changed, 96 insertions(+), 40 deletions(-) diff --git a/collects/drracket/private/language.rkt b/collects/drracket/private/language.rkt index d376243ddb..ccf7aedb4b 100644 --- a/collects/drracket/private/language.rkt +++ b/collects/drracket/private/language.rkt @@ -393,44 +393,50 @@ [pretty-print-columns width] [pretty-print-size-hook - (λ (value display? port) - (cond - [(not (port-writes-special? port)) #f] - [(is-a? value snip%) 1] - [(use-number-snip? value) 1] - [(syntax? value) 1] - [(to-snip-value? value) 1] - [else #f]))] + (let ([oh (pretty-print-size-hook)]) + (λ (value display? port) + (cond + [(not (port-writes-special? port)) (oh value display? port)] + [(is-a? value snip%) 1] + [(use-number-snip? value) 1] + [(syntax? value) 1] + [(to-snip-value? value) 1] + [else (oh value display? port)])))] [pretty-print-print-hook - (λ (value display? port) - (cond - [(image-core:image? value) - - ;; do this computation here so that any failures - ;; during drawing happen under the user's custodian - (image-core:compute-image-cache value) - - (write-special value port) - 1] - [(is-a? value snip%) - (write-special value port) - 1] - [(use-number-snip? value) - (write-special - (case (simple-settings-fraction-style settings) - [(mixed-fraction) - (number-snip:make-fraction-snip value #f)] - [(mixed-fraction-e) - (number-snip:make-fraction-snip value #t)] - [(repeating-decimal) - (number-snip:make-repeating-decimal-snip value #f)] - [(repeating-decimal-e) - (number-snip:make-repeating-decimal-snip value #t)]) - port) - 1] - [(syntax? value) - (write-special (render-syntax/snip value) port)] - [else (write-special (value->snip value) port)]))] + (let ([oh (pretty-print-print-hook)]) + (λ (value display? port) + (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 + ;; during drawing happen under the user's custodian + (image-core:compute-image-cache value) + (write-special value port) + 1] + [else + (write-special value port) + 1])] + [(use-number-snip? value) + (write-special + (case (simple-settings-fraction-style settings) + [(mixed-fraction) + (number-snip:make-fraction-snip value #f)] + [(mixed-fraction-e) + (number-snip:make-fraction-snip value #t)] + [(repeating-decimal) + (number-snip:make-repeating-decimal-snip value #f)] + [(repeating-decimal-e) + (number-snip:make-repeating-decimal-snip value #t)]) + port) + 1] + [(syntax? value) + (write-special (render-syntax/snip value) port)] + [(to-snip-value? value) + (write-special (value->snip value) port)] + [else (oh value display? port)])))] [print-graph ;; only turn on print-graph when using `write' or `print' printing ;; style, because the sharing is being taken care of diff --git a/collects/htdp/bsl/runtime.rkt b/collects/htdp/bsl/runtime.rkt index 342754248b..d612aad346 100644 --- a/collects/htdp/bsl/runtime.rkt +++ b/collects/htdp/bsl/runtime.rkt @@ -1,7 +1,10 @@ #lang racket/base (require mzlib/pconvert racket/pretty - lang/private/set-result) + lang/private/set-result + mrlib/image-core + racket/snip + racket/class) (provide configure) @@ -15,6 +18,7 @@ (lambda (val basic sub) (cond [(equal? val set!-result) '(void)] + [(is-image? val) val] [else (ph val basic sub)])))) (use-named/undefined-handler (lambda (x) @@ -28,17 +32,41 @@ ;; Set pretty-print options: (pretty-print-show-inexactness #t) (pretty-print-exact-as-decimal #t) + (define img-str "#") + (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)) ;; 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 (lambda (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)]) (global-port-print-handler (lambda (val port [depth 0]) (parameterize ([global-port-print-handler orig]) (let ([val (print-convert val)]) (parameterize ([pretty-print-columns 'infinity]) - (pretty-write val port)))))))) + (set-handlers + (λ () (pretty-write val port)))))))))) diff --git a/collects/lang/htdp-langs.rkt b/collects/lang/htdp-langs.rkt index 338c61d80b..b1ab27637b 100644 --- a/collects/lang/htdp-langs.rkt +++ b/collects/lang/htdp-langs.rkt @@ -16,6 +16,7 @@ framework/private/bday syntax/moddep mrlib/cache-image-snip + (prefix-in ic: mrlib/image-core) setup/dirs test-engine/racket-tests @@ -192,6 +193,12 @@ ;; set-printing-parameters : settings ( -> TST) -> TST ;; is implicitly exposed to the stepper. watch out! -- john (define/public (set-printing-parameters settings thunk) + (define img-str "#") + (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] [pc:abbreviate-cons-as-list (get-abbreviate-cons-as-list)] [pc:current-print-convert-hook @@ -202,6 +209,21 @@ [else (ph val basic sub)])))] [pretty-print-show-inexactness #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 (lambda (x) (and (get-use-function-output-syntax?)