[mcclim-devel] Scigraph
Aleksandar Bakic
a_bakic at yahoo.com
Mon May 2 15:30:35 UTC 2005
Hi,
I've had minor problems with Scigraph and a recent CMUCL snapshot. Here are two
patches that work for me:
*** Apps/Scigraph/dwim/package.lisp 6 Aug 2004 13:19:40 -0000 1.4
--- Apps/Scigraph/dwim/package.lisp 2 May 2005 15:24:25 -0000
***************
*** 50,56 ****
parse-error *default-server-path*)
#+clim
! (:use clim-lisp)
#-clim
(:use lisp clos)))
--- 50,56 ----
parse-error *default-server-path*)
#+clim
! (:use :clim-lisp)
#-clim
(:use lisp clos)))
and
*** Apps/Scigraph/scigraph/draw.lisp 6 Aug 2004 13:19:40 -0000 1.2
--- Apps/Scigraph/scigraph/draw.lisp 2 May 2005 15:24:41 -0000
***************
*** 135,145 ****
(with-drawing-options (,stream :clipping-region .x.)
, at body)))
(:clim-2
! (let ((.x. *clim-clip-rectangle*))
! (setf (bounding-rectangle-min-x .x.) le
! (bounding-rectangle-min-y .x.) te
! (bounding-rectangle-max-x .x.) re
! (bounding-rectangle-max-y .x.) be)
(with-drawing-options (,stream :clipping-region .x.)
, at body))))))
--- 135,150 ----
(with-drawing-options (,stream :clipping-region .x.)
, at body)))
(:clim-2
! (let* ((.x. *clim-clip-rectangle*)
! (coords (slot-value .x. 'coordinates))) ;mcclim only
! (setf (aref coords 0) le
! (aref coords 1) te
! (aref coords 2) re
! (aref coords 3) be)
! ;; (setf (bounding-rectangle-min-x .x.) le
! ;; (bounding-rectangle-min-y .x.) te
! ;; (bounding-rectangle-max-x .x.) re
! ;; (bounding-rectangle-max-y .x.) be)
(with-drawing-options (,stream :clipping-region .x.)
, at body))))))
***************
*** 223,229 ****
(clip ,x1 ,x2 yb ,y1 ,y2)))))
(let ((c1 (code x1 y1))
(c2 (code x2 y2)))
! (declare (type (integer 0 9) c1 c2))
(loop (and (zerop c1) (zerop c2) (return (values x1 y1 x2 y2)))
(or (zerop (logand c1 c2)) (return nil))
(clip-point c1 x1 y1 x2 y2)
--- 228,234 ----
(clip ,x1 ,x2 yb ,y1 ,y2)))))
(let ((c1 (code x1 y1))
(c2 (code x2 y2)))
! (declare (type (integer 0 10) c1 c2))
(loop (and (zerop c1) (zerop c2) (return (values x1 y1 x2 y2)))
(or (zerop (logand c1 c2)) (return nil))
(clip-point c1 x1 y1 x2 y2)
***************
*** 425,448 ****
(when transform
(multiple-value-setq (x1 y1) (uv-to-screen stream x1 y1))
(multiple-value-setq (x2 y2) (uv-to-screen stream x2 y2)))
! (multiple-value-setq (x1 y1 x2 y2) (clip-line-to-clip-rectangle x1 y1 x2
y 2))
! (if x1
! (if (zerop dash-pattern)
! (progn
! (draw-line x1 y1 x2 y2 :stream stream :alu alu
! :thickness thickness :line-end-shape
! (if end-point-p line-end-shape
:no-end-point))
! 0.0)
! (progn
! (dash-line
! dash-pattern x1 y1 x2 y2 dash-ds
! :stream stream
! :alu alu
! :thickness thickness
! :pattern pattern)
! ;; draw end caps here.
! ))
! dash-ds))) ; Don't change ds.
(defun device-draw-lines (stream points &rest keys &key &allow-other-keys)
(let ((ds (or (getf keys :dash-ds) 0.0)))
--- 430,454 ----
(when transform
(multiple-value-setq (x1 y1) (uv-to-screen stream x1 y1))
(multiple-value-setq (x2 y2) (uv-to-screen stream x2 y2)))
! (multiple-value-bind (x1 y1 x2 y2)
! (clip-line-to-clip-rectangle x1 y1 x2 y2)
! (if x1
! (if (zerop dash-pattern)
! (progn
! (draw-line x1 y1 x2 y2 :stream stream :alu alu
! :thickness thickness :line-end-shape
! (if end-point-p line-end-shape :no-end-point))
! 0.0)
! (progn
! (dash-line
! dash-pattern x1 y1 x2 y2 dash-ds
! :stream stream
! :alu alu
! :thickness thickness
! :pattern pattern)
! ;; draw end caps here.
! ))
! dash-ds)))) ; Don't change ds.
(defun device-draw-lines (stream points &rest keys &key &allow-other-keys)
(let ((ds (or (getf keys :dash-ds) 0.0)))
Regards,
Alex
__________________________________________________
Do You Yahoo!?
Tired of spam? Yahoo! Mail has the best spam protection around
http://mail.yahoo.com
More information about the mcclim-devel
mailing list