[plt-scheme] Editor Canvas as Output Port

From: Ryan Culpepper (ryan_sml at yahoo.com)
Date: Sun Apr 29 08:45:38 EDT 2007

--- "Williams, M. Douglas" <M.DOUGLAS.WILLIAMS at saic.com> wrote:

> The following short piece of code creates an output port to write
> text onto an editor canvas.  The attached file has a short example.
>  It works, but I'm not sure it's an adequate implementation for
> general usage.  For one thing, it only works for text, while, for
> example, DrScheme lets me write graphic elements (e.g., an image
> snip) using print (or printf even).  Am I correct in that I need to
> supply an optional-write-special-proc to handle these?  It's hard
> to tell from the documentation I've look at so far.

DrScheme's nifty printing comes in two parts. First, the ports
connected to the editor support 'write-special'. So yes, you should
implement the 'optional-write-special-proc' by inserting the special
value (which had better be a snip) into the editor.

The second part connects procedures like 'print', 'display',
'printf', etc to 'write-special'. You need to set the port's print,
display, and write handlers on the port to catch the interesting
values that you want to display graphically and 'write-special' them
to the port.

> (define (make-editor-canvas-port editor-canvas)
>   (let ((text (send editor-canvas get-editor)))
>     (if text
>         (make-output-port
>          'canvas-port
>          always-evt
>          (lambda (s start end non-block? breakable?)
>            (send text insert
>                   (bytes->string/latin-1 s #f start end))
>            (- end start))
>          void)
>         #f)))
> Is there a similar set of procedures that already exist somewhere I
> can use?
> There seem to be similar things in the Application Framework, but
> I've only skimmed over them so far.  They seem to be overkill for
> simple MrEd applications, but that may well be a learning curve
> issue more than anything.

You can look at PLT/collects/mrlib/interactive-value-port.ss for one
example of setting the port handlers. That's not very flexible,

Here's a little toy program that can print colored circles.

  (require (lib "class.ss")
           (lib "mred.ss" "mred"))
  (define f (new frame% (label "hi") (width 400) (height 400)))
  (define t (new text%))
  (define ec (new editor-canvas% (editor t) (parent f)))
  (define (make-editor-output-port text)
    (make-output-port text
                      (lambda (s start end non-block? breakable?)
                        (send text insert
                              (bytes->string/latin-1 s #f start end))
                        (- end start))
                      (lambda (special buffer? breakable?)
                        (send text insert special))))
  (define-struct circle (radius color))
  (define (circle->bitmap c)
    (define diameter (* 2 (circle-radius c)))
    (define bitmap 
      (make-object bitmap% diameter diameter #f))
    (define dc (new bitmap-dc% (bitmap bitmap)))
    (define old-brush (send dc get-brush))
    (define old-pen (send dc get-pen))
    (send dc set-brush (circle-color c) 'solid)
    (send dc set-pen "black" 2 'solid)
    (send dc clear)
    (send dc draw-ellipse 0 0 diameter diameter)
    (send dc set-brush old-brush)
    (send dc set-pen old-pen)
    (send dc set-bitmap #f)
  (define (wrap-port-handler old-handler)
    (lambda (value port)
      (if (circle? value)
           (make-object image-snip% (circle->bitmap value))
          (old-handler value port))))
  (define out (make-editor-output-port t))
   (wrap-port-handler (port-display-handler out)))
   (wrap-port-handler (port-print-handler out)))
  ; out
  ; (wrap-port-handler (port-write-handler out)))
  (send f show #t)
  (display "here's a circle:\n" out)
  (display (make-circle 10 "red") out)
  (fprintf out "\nhere's a bigger one:\n~a\n" 
           (make-circle 50 "green"))
  (display "and if you uncomment the lines above...\n" out)
  (write (make-circle 30 "purple") out)

Hope that gets you going in the right direction.

Do You Yahoo!?
Tired of spam?  Yahoo! Mail has the best spam protection around 

Posted on the users mailing list.