Commit 4df0a661 authored by Alastair Bridgewater's avatar Alastair Bridgewater
Browse files

medium/drawing,backend/clx/medium: Rough in more medium drawing functions.

  * This is the rest of 12.7.2, with the exceptions of MEDIUM-DRAW-
ELLIPSE*, which is tricky because X is limited to axis-aligned
ellipses, and MEDIUM-DRAW-TEXT*, which is tricky simply because it
involves text and fonts.

  * This functionality is completely untested, beyond checking
that BACKEND/CLX/MEDIUM::FIX-RECTANGLE-COORD-SEQ-FOR-X behaves
correctly.
parent 0ae564ed
......@@ -22,9 +22,55 @@
(make-instance 'clx-medium 'drawable drawable 'gcontext gcontext))
(defmethod medium-draw-point* ((medium clx-medium) x y)
(with-slots (drawable gcontext)
medium
(xlib:draw-point drawable gcontext x y)))
(defmethod medium-draw-points* ((medium clx-medium) coord-seq)
(with-slots (drawable gcontext)
medium
(xlib:draw-points drawable gcontext coord-seq)))
(defmethod medium-draw-line* ((medium clx-medium) x1 y1 x2 y2)
(with-slots (drawable gcontext)
medium
(xlib:draw-line drawable gcontext x1 y1 x2 y2)))
(defmethod medium-draw-lines* ((medium clx-medium) coord-seq)
(with-slots (drawable gcontext)
medium
(xlib:draw-segments drawable gcontext coord-seq)))
(defmethod medium-draw-polygon* ((medium clx-medium) coord-seq closed filled)
(with-slots (drawable gcontext)
medium
(if (and closed (not filled))
;; X won't close a polyline automatically, we have to use
;; coincident first and last points explicitly.
(let ((first-point (subseq coord-seq 0 2)))
(xlib:draw-lines drawable gcontext (append coord-seq first-point)))
(xlib:draw-lines drawable gcontext coord-seq :fill-p filled))))
(defmethod medium-draw-rectangle* ((medium clx-medium) x1 y1 x2 y2 filled)
(with-slots (drawable gcontext)
medium
(xlib:draw-rectangle drawable gcontext x1 y1 (- x2 x1) (- y2 y1) filled)))
(defun fix-rectangle-coord-seq-for-x (coord-seq)
;; XLIB:DRAW-RECTANGLES takes x, y, width, height, but we have x, y,
;; x+width, y+height.
(loop
for (x1 y1 x2 y2 . rest) on (coerce coord-seq 'list) by #'cddddr
collect x1
collect y1
collect (- x2 x1)
collect (- y2 y1)))
(defmethod medium-draw-rectangles* ((medium clx-medium) coord-seq filled)
(with-slots (drawable gcontext)
medium
(let ((fixed-coord-seq (fix-rectangle-coord-seq-for-x coord-seq)))
(xlib:draw-rectangles drawable gcontext fixed-coord-seq filled))))
;;; EOF
......@@ -7,10 +7,22 @@
(cl:defpackage :nq-clim/medium/drawing
(:use :cl)
(:export
"MEDIUM-DRAW-LINE*"))
"MEDIUM-DRAW-POINT*"
"MEDIUM-DRAW-POINTS*"
"MEDIUM-DRAW-LINE*"
"MEDIUM-DRAW-LINES*"
"MEDIUM-DRAW-POLYGON*"
"MEDIUM-DRAW-RECTANGLE*"
"MEDIUM-DRAW-RECTANGLES*"))
(cl:in-package :nq-clim/medium/drawing)
(defgeneric medium-draw-point* (medium x y))
(defgeneric medium-draw-points* (medium coord-seq))
(defgeneric medium-draw-line* (medium x1 y1 x2 y2))
(defgeneric medium-draw-lines* (medium coord-seq))
(defgeneric medium-draw-polygon* (medium coord-seq closed filled))
(defgeneric medium-draw-rectangle* (medium x1 y1 x2 y2 filled))
(defgeneric medium-draw-rectangles* (medium coord-seq filled))
;;; EOF
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment