Hi,
Two weeks ago I posted a message about a LispView patch to draw filled
polygons, but some people seemed to have problems with my e-mail
address (funny, first time that happens... hmmm...), so I am posting
it this time.
Sorry for the inconvenience...
Follow this procedure to add the draw-polygon method to your LispView package.
First, an important remark:
IT SEEMS THIS PATCH WONT WORK WITH VERSION 1.0 OF LISPVIEW. If anyone out
there ever finds out why... my address is included! I run it in LV 1.1
and all is well though...
There are two options to this patch:
1- load the lisp code in the LISPVIEW package of your running image
(either by adding it to your program or loading it in manually (or
even automatically via the lisp-init.lisp file))
This happens to be the only option if you do not have the LispView 1.1
sources. Note that they are available for anonymous ftp at
export.lcs.mit.edu in the /contrib directory (look for 'lispview1.1').
2- modify the LispView sources and recompile the whole shebang!
=========
Option 1:
=========
Load the following code in your running image after you've made sure
LispView is loaded:
;;; Begin included code
;;;
;;; Define the method 'draw-polygon' in the same manner every other
;;; output method is defined
;;;
;;; Note: this is top-level code
(in-package 'lv)
(macrolet
((def-output-method (name check-arglist &rest args)
(let* ((key-position (position '&key args :test #'eq))
(required-arglist (if key-position
(subseq args 0 key-position)
args))
(drawable (car (find 'drawable required-arglist :key #'cadr :test #'eq)))
(keyword-args
(append '(clip-mask
clip-x-origin
clip-y-origin)
(if key-position
(subseq args (1+ key-position)))))
(driver (intern (format nil "DD-~A" name)))
(driver-args
(mapcar #'(lambda (arg)
(if (consp arg) (car arg) arg))
required-arglist))
(display-var (gensym))
(gc-args
(mapcan #'(lambda (keyword-arg)
(let ((keyword (if (consp keyword-arg)
(car keyword-arg)
keyword-arg)))
(if (member keyword graphics-context-slot-names :test #'eq)
(list (intern (string keyword) (find-package :keyword))
keyword)
(progn
(setq driver-args (append driver-args (list keyword)))
nil))))
keyword-args)))
(unless drawable
(error "Couldn't locate a drawable in arglist ~S" args))
`(defmethod ,name (,@required-arglist &rest args
&key
gc
,@keyword-args
&allow-other-keys)
(declare (dynamic-extent args))
,check-arglist
(unless gc
(setq gc (graphics-context (display ,drawable))))
(check-type gc graphics-context)
(if (or (null args)
(and (eq (car args) :gc) (= (length args) 2)))
(,driver (platform gc) gc ,@driver-args)
(with-graphics-context (gc ,@gc-args)
(,driver (platform gc) gc ,@driver-args)))))))
;; Now define the desired output method
(def-output-method draw-polygon
(check-type accessor function)
(d drawable) vertices accessor
&key operation plane-mask foreground line-width line-style join-style
fill-style tile stipple ts-x-origin ts-y-origin subwindow-mode dash-offset
dashes fill-p cap-style fill-rule (shape-hint :complex)))
;;; Now add the internal LispView definition
;;;
;;; (This code was written by Len Charest, Jr.
;;; He submitted it to me after I asked him about drawing closed polygons
;;; in LispView; it needed only a minor touch-up and the previously
;;; listed code to work... Thanx Len! Without you I might not
;;; even have tried to write a patch...)
(defmethod dd-draw-polygon ((p XView) gc drawable vertices accessor filled shape)
(XV:with-xview-lock
(let* ((xvo (device drawable))
(dsp (xview-object-dsp xvo))
(xid (xview-object-xid xvo))
(xgc (xview-object-xid (device gc)))
(shape (case shape
(:convex X11:convex)
(:non-convex X11:nonconvex)
(otherwise X11:complex)))
(n-points (list-length vertices))
(points (malloc-foreign-pointer
:type `(:pointer (:array X11:xpoint (,n-points))))))
(when (and xgc xid)
(let ((i 0))
(dolist (point vertices)
(multiple-value-bind (x y)
(funcall accessor point)
(let ((p (foreign-aref points i)))
(setf (X11:xpoint-x p) x
(X11:xpoint-y p) y)))
(incf i)))
(setf (foreign-pointer-type points) '(:pointer X11:xpoint))
(if filled
(X11:XFillPolygon dsp xid xgc points n-points shape X11:CoordModeOrigin)
(X11:XDrawLines dsp xid xgc points n-points X11:CoordModeOrigin))
(xview-maybe-XFlush (xview-object-xvd xvo) dsp))
(free-foreign-pointer points))))
;;; End included code.
That's it for option 1!
=========
Option 2:
=========
If you have the sources to LispView, find the following code in the
file $LISPVIEWHOME/lispview/src/output.lisp (it should be easy to spot,
it's preceded by #+ignore... no wonder it wasn't working! (that's not
the only reason though...))
#+ignore
(def-output-method draw-polygon
(d drawable) vertices accessor
&key operation plane-mask foreground line-width line-style join-style fill-style tile stipple
ts-x-origin ts-y-origin subwindow-mode dash-offset dashes closed fill-p)
Now, replace it by the following (make sure you remove the #+ignore
from the file):
(def-output-method draw-polygon
(check-type accessor function)
(d drawable) vertices accessor
&key clip-mask clip-x-origin clip-y-origin operation plane-mask foreground line-width line-style join-style fill-style tile stipple ts-x-origin ts-y-origin subwindow-mode dash-offset dashes fill-p cap-style fill-rule (shape-hint :complex) &allow-other-keys)
Once that's done, save the file and edit this other file:
$LISPVIEWHOME/lispview/src/xview-output.lisp
Find the following definition:
(defmethod dd-draw-rectangles ((p XView) gc drawable rectangles accessor filled) ...
Now add the following code just BEFORE that definition:
;;; Now add the internal LispView definition
;;;
;;; (This code was written by Len Charest, Jr.
;;; He submitted it to me after I asked him about drawing closed polygons
;;; in LispView; it needed only a minor touch-up and the previously
;;; listed code to work... Thanx Len! Without you I might not
;;; even have tried to write a patch...)
(defmethod dd-draw-polygon ((p XView) gc drawable vertices accessor filled shape)
(XV:with-xview-lock
(let* ((xvo (device drawable))
(dsp (xview-object-dsp xvo))
(xid (xview-object-xid xvo))
(xgc (xview-object-xid (device gc)))
(shape (case shape
(:convex X11:convex)
(:non-convex X11:nonconvex)
(otherwise X11:complex)))
(n-points (list-length vertices))
(points (malloc-foreign-pointer
:type `(:pointer (:array X11:xpoint (,n-points))))))
(when (and xgc xid)
(let ((i 0))
(dolist (point vertices)
(multiple-value-bind (x y)
(funcall accessor point)
(let ((p (foreign-aref points i)))
(setf (X11:xpoint-x p) x
(X11:xpoint-y p) y)))
(incf i)))
(setf (foreign-pointer-type points) '(:pointer X11:xpoint))
(if filled
(X11:XFillPolygon dsp xid xgc points n-points shape X11:CoordModeOrigin)
(X11:XDrawLines dsp xid xgc points n-points X11:CoordModeOrigin))
(xview-maybe-XFlush (xview-object-xvd xvo) dsp))
(free-foreign-pointer points))))
;;; End included code.
Once that's done, save your work!
You're now ready to recompile the whole LispView package.
All the instructions you need for that are in the lispview folder, including
those that pertain to building a new lisp image that includes LispView.
The function syntax is the same as other LispView functions
(you might want to add this to your manual, p.116):
draw-polygon (d drawable) points accessor [Method]
&key :gc :clip-mask :clip-x-origin :clip-y-origin :operation :plane-mask
:foreground :line-width :line-style :join-style :fill-style :tile
:stipple :ts-x-origin :ts-y-origin :subwindow-mode :dash-offset
:dashes :fill-p :cap-style :fill-rule :shape-hint &allow-other-keys
Draws a polygon by connecting x, y in the listed order.
The value of the accessor must be a function that returns,
as multiple values, the two coordinates of each point, x, y, when
applied to each item in points. If fill-p is non-nil, then the polygon is
filled according to the current gc. :shape-hint defaults to :complex, but
can also be one of :convex or :non-convex (refer to the Xlib manual for a
description of these parameters).
Ex: (draw-polygon (vue-popup-canvas octavue)
'((0 0) (10 0) (20 10) (30 100) (20 150))
#'values-list :fill-p t :shape-hint :convex)
That's it! I hope everything worked out fine at your site.
Drop me a line if you ever find the patch useful... just say hi ;-)
Pierre Vachon Laboratoire de vision et systemes numeriques
······@gel.ulaval.ca Universite Laval, Quebec, Canada.