McCLIM backends - Part 2: Stream Output Protocol
Tagged as lisp, clim, backends, tutorial
Written on 2022-04-19 by Daniel 'jackdaniel' Kochmański
Table of Contents
Introduction
In "Part I" we've created an SVG backend implementing the Medium Output Protocol. This tutorial is focused on grafts, sheets and CLIM streams.
- graft: an object representing the screen
- sheet: an object representing a window
- CLIM stream: a sheet with a stream interface
We can do various sorts of graphics with the current backend - draw ellipses, embed images, add styling to lines. That is not all that CLIM has to offer. For example, formatting a table requires a second pass over output records to arrange cells in the table grid.
Creating a graft
A graft is an object that represents the output device. A graft may be a computer screen, a document, or some other abstract entity (like a window!). It is used to graft sheets, to query important information about the output, and to transform between the coordinate system of CLIM and the coordinate system of the output device.
What is the output device coordinate system? That depends on the backend. The default screen orientation in SVG is "default"1.
(defclass svg-graft (graft)
((density :initarg :dpi :reader density)
(region :initarg :region :reader sheet-native-region)
(native :initarg :native :reader sheet-native-transformation)))
(defmethod print-object ((graft svg-graft) stream)
(print-unreadable-object (graft stream :type t :identity nil)
(format stream "~ax~a"
(graft-width graft :units :device)
(graft-height graft :units :device))))
;;; The constructor is used as a converter - it is possible to supply any valid
;;; combination of the orientation and units and the created graft will have its
;;; native transformation convert supplied parameters to device parameters:
;;;
;;; (ORIENTATION, UNITS) -> (:DEFAULT :DEVICE)
;;;
(defmethod climb:make-graft ((port svg-port) &key (orientation :default) (units :device))
(destructuring-bind (port-type &key (width 640) (height 360) (dpi 96) &allow-other-keys)
(port-server-path port)
(declare (ignore port-type))
(let* ((graft (make-instance 'svg-graft :orientation orientation :units units
:mirror (destination port)
:dpi dpi
:region (make-rectangle* 0 0 width height)))
;; Transform graft units to 1/dpi (for example 1/96in).
(units-transformation
(make-scaling-transformation (/ width (graft-width graft :units units))
(/ height (graft-height graft :units units))))
(orientation-transformation (ecase orientation
(:graphics (compose-transformations
(make-translation-transformation 0 height)
(make-reflection-transformation* 0 0 1 0)))
(:default +identity-transformation+)))
(region (make-rectangle* 0 0 width height))
(native (compose-transformations orientation-transformation units-transformation)))
(setf (slot-value graft 'region) region)
(setf (slot-value graft 'native) native)
graft)))
(defmethod graft-width ((graft svg-graft) &key (units :device))
(let ((native-width (bounding-rectangle-width (sheet-native-region graft))))
(ecase units
(:device native-width)
(:inches (/ native-width (density graft)))
(:millimeters (* (/ native-width (density graft)) 25.4))
(:screen 1))))
(defmethod graft-height ((graft svg-graft) &key (units :device))
(let ((native-height (bounding-rectangle-height (sheet-native-region graft))))
(ecase units
(:device native-height)
(:inches (/ native-height (density graft)))
(:millimeters (* (/ native-height (density graft)) 25.4))
(:screen 1))))
Voila, the graft has been created. Now we can "ask" the screen for its dimensions:
CLIM-USER> (climb:with-port (port :svg :width 640 :height 360 :dpi 96)
(setf (mcclim-svg::destination port) :dummy)
(let ((graft (climb:make-graft port :orientation :graphics :units :device)))
(print graft)
(print (sheet-native-transformation graft))
(print (list (float (graft-height graft :units :inches))
(float (graft-width graft :units :inches))))
(values)))
#<SVG-GRAFT 640x360>
#<STANDARD-HAIRY-TRANSFORMATION 1 0 0 -1 0 360>
(3.75 6.6666665)
Implementing the stream output protocol
I have to disappoint you. We don't have to implement anything, we may
use the class clim-stream-pane and benefit from goodies coming with
the stream output protocol. To be able to pass the parameter :units
and :orientation let's redefine the server path parser to accept
additional parameters. To replace the medium with the stream in the
drawing context we'll also redefine the method for the function
invoke-with-output-to-drawing-stream:
(defun parse-server-path (server-path)
(destructuring-bind (port-type &rest args)
server-path
(list* port-type :id (gensym) args)))
(defmethod invoke-with-output-to-drawing-stream
(continuation (port svg-port) (destination stream) &rest args)
(declare (ignore args))
(destructuring-bind (port-type &key (units :device) (orientation :default) &allow-other-keys)
(port-server-path port)
(declare (ignore port-type))
(setf (destination port) destination)
(let ((graft (make-graft port :units units :orientation orientation)))
(let* ((w-in (format nil "~ain" (fmt (graft-width graft :units :inches))))
(h-in (format nil "~ain" (fmt (graft-height graft :units :inches))))
(*viewport-w* (graft-width graft :units :device))
(*viewport-h* (graft-height graft :units :device))
(bbox (format nil "0 0 ~a ~a" (fmt *viewport-w*) (fmt *viewport-h*)))
(sheet-region (untransform-region
(sheet-native-transformation graft)
(sheet-native-region graft)))
(sheet (make-instance 'clim-stream-pane :port port :background +white+
:region sheet-region)))
(sheet-adopt-child graft sheet)
(cl-who:with-html-output (destination destination)
(:svg :version "1.1" :width w-in :height h-in :|viewBox| bbox
:xmlns "http://www.w3.org/2000/svg"
:|xmlns:xlink| "http://www.w3.org/1999/xlink"
(funcall continuation sheet)))))))
For example, we can now write to the stream with format, draw
graphs, and format tables with data:
(defun format-table (stream rows cols)
(formatting-table (stream)
(dotimes (row rows)
(formatting-row (stream)
(dotimes (col cols)
(formatting-cell (stream)
(surrounding-output-with-border (stream)
(format stream "Row ~s, Col ~s" row col))))))))
(defun format-graph (stream depth breadth)
(format-graph-from-roots
(list depth)
(lambda (obj str)
(surrounding-output-with-border (stream)
(format str "Node ~s" obj)))
(lambda (obj)
(when (plusp obj)
(make-list breadth :initial-element (1- obj))))
:stream stream :orientation :vertical))
(with-output-to-drawing-stream (stream :svg "/tmp/formatted-output.svg" :preview t
:width 640 :height 360)
(medium-clear-area stream 0 0 640 360)
(format stream "~a ~a~%"
(graft-units (graft stream))
(graft-orientation (graft stream)))
(format-graph stream 3 2)
(terpri stream)
(format-table stream 3 2))
What is the coordinate system of CLIM? That is entirely up to the
graft! When we graft a sheet to the graft with units :millimeters,
then native coordinates are specified in millimeters. When the
orientation is :graphics, then the origin is located at the
lower-left corner and Y grows upwards.
(with-output-to-drawing-stream (stream :svg "/tmp/upside-down-output.svg" :preview t
:width 640 :height 360
:orientation :graphics)
(medium-clear-area stream 0 0 640 360)
(format stream "~a ~a~%"
(graft-units (graft stream))
(graft-orientation (graft stream)))
(format-graph stream 3 2)
(terpri stream)
(format-table stream 3 2))
Let's throw in one extra feature to our drawing backend that scales the output to always fit in the viewport. This is similar to other drawing backends. Notice, that we compare the history size in the stream coordinates with dimensions of the graft in specified units.
(defun scale-to-fit (continuation stream)
(with-output-recording-options (stream :record t :draw nil)
(funcall continuation stream))
(let* ((history (stream-output-history stream))
(graft (graft stream))
(scale (min (/ (graft-width graft :units (graft-units graft))
(bounding-rectangle-width history))
(/ (graft-height graft :units (graft-units graft))
(bounding-rectangle-height history))))
(transformation (compose-transformation-with-scaling
(make-translation-transformation
(- (bounding-rectangle-min-x history))
(- (bounding-rectangle-min-y history)))
scale scale)))
(with-output-recording-options (stream :draw t :record nil)
(climi::letf (((sheet-transformation stream) transformation))
(replay history stream)))))
(defmethod invoke-with-output-to-drawing-stream
(continuation (port svg-port) (destination stream) &rest args)
(declare (ignore args))
(destructuring-bind (port-type &key (units :device) (orientation :default) (scale-to-fit nil)
&allow-other-keys)
(port-server-path port)
(declare (ignore port-type))
(setf (destination port) destination)
(let ((graft (make-graft port :units units :orientation orientation)))
(let* ((w-in (format nil "~ain" (fmt (graft-width graft :units :inches))))
(h-in (format nil "~ain" (fmt (graft-height graft :units :inches))))
(*viewport-w* (graft-width graft :units :device))
(*viewport-h* (graft-height graft :units :device))
(bbox (format nil "0 0 ~a ~a" (fmt *viewport-w*) (fmt *viewport-h*)))
(sheet-region (if scale-to-fit
+everywhere+ ; don't clip when fitting
(untransform-region
(sheet-native-transformation graft)
(sheet-native-region graft))))
(sheet (make-instance 'clim-stream-pane :port port :background +white+
:region sheet-region)))
(sheet-adopt-child graft sheet)
(cl-who:with-html-output (destination destination)
(:svg :version "1.1" :width w-in :height h-in :|viewBox| bbox
:xmlns "http://www.w3.org/2000/svg"
:|xmlns:xlink| "http://www.w3.org/1999/xlink"
(if scale-to-fit
(scale-to-fit continuation sheet)
(funcall continuation sheet))))))))
On the first image we see the output drawn with the unit being :millimeters, and
clipped by the viewport specified in the device units. Notice that the last
letter of the text is wrapped - that indicates that the stream region is correct.
(with-output-to-drawing-stream (stream :svg "/tmp/truncated-millimeters.svg" :preview t
:width 640 :height 360
:orientation :graphics
:units :millimeters
:scale-to-fit nil)
(medium-clear-area stream 0 0 640 360)
(draw-circle* stream 0 0 100 :ink +dark-red+)
(format stream "~a ~a~%"
(graft-units (graft stream))
(graft-orientation (graft stream)))
(format-graph stream 3 2)
(terpri stream)
(format-table stream 10 8))
On the second image we see a clipped image which units are :device (the same
as the viewport).
(with-output-to-drawing-stream (stream :svg "/tmp/truncated-millimeters.svg" :preview t
:width 640 :height 360
:orientation :graphics
:units :millimeters
:scale-to-fit nil)
(medium-clear-area stream 0 0 640 360)
(draw-circle* stream 0 0 100 :ink +dark-red+)
(format stream "~a ~a~%"
(graft-units (graft stream))
(graft-orientation (graft stream)))
(format-graph stream 3 2)
(terpri stream)
(format-table stream 10 8))
The third image scales the history to fit in the viewport. For giggles we'll
specify the unit to be :inches2.
(with-output-to-drawing-stream (stream :svg "/tmp/truncated-inches.svg" :preview t
:width 15 :height :compute
:orientation :graphics
:units :inches
:scale-to-fit t)
(surrounding-output-with-border (stream :background +white+ :filled t)
(draw-circle* stream 0 0 100 :ink +dark-red+)
(format stream "~a ~a~%"
(graft-units (graft stream))
(graft-orientation (graft stream)))
(format-graph stream 3 2)
(terpri stream)
(format-table stream 10 8)))
Conclusions
This concludes the case study of the SVG backend. The code in McCLIM will most likely evolve with time to fix some issues, and to account for new interfaces. But with this knowledge you, the backend developer, should have a good hang of things that need to be done when implementing a new drawing backend for McCLIM.
The next part of the tutorial will cover input processing in the interactive backend.
PS You may leave me a feedback on my email or join our irc channel.
PPS You may support my FLOSS work and blogging by becoming my patron.
PPPS The SVG backend is already available in the master branch of McCLIM.
Footnotes
1 PostScript on the other hand is oriented in :graphics coordinates.
2 For even more giggles and some fine keming specify the unit :screen.