From 8f2e4ba17b704965f3a35d1d0a312dec31800862 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Sun, 2 Sep 2012 20:19:36 +0200 Subject: racket: displaying images also during evaluations --- scheme/racket/geiser/images.rkt | 46 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 46 insertions(+) create mode 100644 scheme/racket/geiser/images.rkt (limited to 'scheme/racket/geiser/images.rkt') diff --git a/scheme/racket/geiser/images.rkt b/scheme/racket/geiser/images.rkt new file mode 100644 index 0000000..ddc0286 --- /dev/null +++ b/scheme/racket/geiser/images.rkt @@ -0,0 +1,46 @@ +;;; images.rkt -- support for image handline + +;; Copyright (C) 2012 Jose Antonio Ortega Ruiz + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the Modified BSD License. You should +;; have received a copy of the license along with this program. If +;; not, see . + +;; Authors: Michael Wilber, Jose Antonio Ortega Ruiz +;; Start date: Sun Sep 2, 2012 18:54 + + +#lang racket/base + +(require racket/file file/convertible racket/pretty) +(provide image-cache maybe-print-image maybe-write-image) + +(define image-cache + (let ([ensure-dir (lambda (dir) + (if (path-string? dir) + (begin (make-directory* dir) + (if (path? dir) (path->string dir) dir)) + (path->string (find-system-path 'temp-dir))))]) + (make-parameter (ensure-dir #f) ensure-dir))) + +(define (save-tmpimage imgbytes) + ;; Save imgbytes to a new temporary file and return the filename + (define filename (make-temporary-file "geiser-img-~a.png" #f (image-cache))) + (with-output-to-file filename #:exists 'truncate + (lambda () (display imgbytes))) + (format "#" filename)) + +(define (maybe-save-image value) + (and (convertible? value) + ;; (The above could be problematic if a future version of racket + ;; suddenly decides it can "convert" strings to picts) + (save-tmpimage (convert value 'png-bytes)))) + +(define (maybe-print-image value) + (cond [(maybe-save-image value) => (lambda (s) (printf "~a\n" s))] + [else (unless (void? value) + (pretty-print value))])) + +(define (maybe-write-image value) + (write (or (maybe-save-image value) value))) -- cgit v1.2.3