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-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)
(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]
[(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)]))]
;; 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

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

@ -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 "#<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))
;; 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))))))))))

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

@ -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 "#<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]
[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?)