[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