mcclim-cvs January 2008

mcclim-cvs@common-lisp.net

7 participants
255 discussions

[mcclim-cvs] CVS mcclim/ESA
by thenriksen 07 Jan '08

07 Jan '08

Update of /project/mcclim/cvsroot/mcclim/ESA In directory clnet:/tmp/cvs-serv12937/ESA Modified Files: packages.lisp utils.lisp Log Message: Changed the update-syntax protocol to use a nonstandard method combination for added job security. --- /project/mcclim/cvsroot/mcclim/ESA/packages.lisp 2008/01/01 18:43:36 1.9 +++ /project/mcclim/cvsroot/mcclim/ESA/packages.lisp 2008/01/07 22:01:59 1.10 @@ -44,6 +44,7 @@ #:subtype-compatible-p #:capitalize #:ensure-array-size + #:values-max-min #:observable-mixin #:add-observer #:remove-observer #:observer-notified #:notify-observers --- /project/mcclim/cvsroot/mcclim/ESA/utils.lisp 2008/01/01 18:43:36 1.6 +++ /project/mcclim/cvsroot/mcclim/ESA/utils.lisp 2008/01/07 22:01:59 1.7 @@ -233,6 +233,34 @@ do (setf (elt array i) (funcall new-elem-fn))))) array) +(define-method-combination values-max-min + (&optional (order ':most-specific-last)) + ((around (:around)) + (before (:before)) + (after (:after)) + (primary (values-max-min) :order order :required t)) + (flet ((call-methods (methods) + (mapcar (lambda (m) `(call-method ,m)) methods)) + (call-vmm-methods (methods) + `(multiple-value-bind (max min) + (call-method ,(first methods)) + (progn + ,@(loop for m in (rest methods) + collect `(multiple-value-bind (mmax mmin) + (call-method ,m) + (setq max (max max mmax) + min (min min mmin))))) + (values max min)))) + (let ((form (if (or around before after (rest primary)) + `(multiple-value-prog1 + (progn ,@(call-methods before) + ,(call-vmm-methods primary)) + (progn ,@(call-methods (reverse after)))) + `(call-method ,(first primary))))) + (if around + `(call-method ,(first around) (,@(rest around) (make-method ,form))) + form)))) + (defclass observable-mixin () ((%observers :accessor observers :initform '()))

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 07 Jan '08

07 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv23949/Drei Modified Files: drei-redisplay.lisp Log Message: Fixed the bouncy lines problem once and for all! --- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/07 13:30:55 1.21 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/07 20:23:45 1.22 @@ -395,6 +395,10 @@ (y2 dimensions) y2 (center dimensions) center))) +(defconstant +roman-face-style+ (make-text-style nil :roman nil) + "A text style specifying a roman face, but with unspecified +family and size.") + (defun stroke-drawing-fn (stream view stroke cursor-x cursor-y) "Draw `stroke' to `stream' at the position (`cursor-x', `cursor-y'). `View' is the view object that `stroke' belongs @@ -413,8 +417,13 @@ (merged-text-style (merge-text-styles (face-style (drawing-options-face drawing-options)) (medium-merged-text-style (sheet-medium stream)))) - (text-style-ascent (text-style-ascent merged-text-style (sheet-medium stream))) - (text-style-descent (text-style-descent merged-text-style (sheet-medium stream))) + ;; Ignore face when computing height, otherwise we get + ;; bouncy lines when things like parenmatching bolds parts + ;; of the line. + (roman-text-style (merge-text-styles +roman-face-style+ + merged-text-style)) + (text-style-ascent (text-style-ascent roman-text-style (sheet-medium stream))) + (text-style-descent (text-style-descent roman-text-style (sheet-medium stream))) (text-style-height (+ text-style-ascent text-style-descent))) (with-accessors ((x1 x1) (y1 y1) (x2 x2) (y2 y2) (center center)) dimensions (multiple-value-bind (width ignore1 ignore2 ignore3 baseline)

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 07 Jan '08

07 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv17553/Drei Modified Files: lisp-syntax.lisp lr-syntax.lisp Log Message: Made parenmatching more elegant by sprinling the magic dust of refactoring. --- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2008/01/07 12:00:43 1.53 +++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2008/01/07 15:32:15 1.54 @@ -1841,19 +1841,18 @@ :style (make-text-style nil :italic nil))) (comment (:face :ink +maroon+ :style (make-text-style :serif :bold :large))) (literal-object-form (:options :function (object-drawer))) - (complete-token-form (:function #'(lambda (syntax form) - (cond ((symbol-form-is-keyword-p syntax form) + (complete-token-form (:function #'(lambda (view form) + (cond ((symbol-form-is-keyword-p (syntax view) form) keyword-drawing-options) - ((symbol-form-is-macrobound-p syntax form) + ((symbol-form-is-macrobound-p (syntax view) form) macro-drawing-options) - ((symbol-form-is-boundp syntax form) + ((symbol-form-is-boundp (syntax view) form) bound-drawing-options) (t +default-drawing-options+))))) - (parenthesis-lexeme (:function #'(lambda (syntax form) - (declare (ignore syntax)) - ;; XXX: Using (point) here may be hacky. - (if (and (or (mark= (point) (start-offset (parent form))) - (mark= (point) (end-offset (parent form)))) + (parenthesis-lexeme (:function #'(lambda (view form) + (if (and (typep view 'point-mark-view) + (or (mark= (point view) (start-offset (parent form))) + (mark= (point view) (end-offset (parent form)))) (form-complete-p (parent form))) highlighted-parenthesis-options +default-drawing-options+)))))) --- /project/mcclim/cvsroot/mcclim/Drei/lr-syntax.lisp 2008/01/04 14:12:48 1.9 +++ /project/mcclim/cvsroot/mcclim/Drei/lr-syntax.lisp 2008/01/07 15:32:15 1.10 @@ -431,29 +431,30 @@ draw the parser symbol. `:function', in which case `args' must be a single element, a - function that takes two arguments. These arguments are the - syntax and the parser symbol, and the return value of this - function is the `drawing-options' object that will be used to - draw the parser-symbol." + function that takes two arguments. These arguments are the view + of the syntax and the parser symbol, and the return value of + this function is the `drawing-options' object that will be used + to draw the parser-symbol." (check-type name symbol) `(progn (fmakunbound ',name) - (defgeneric ,name (syntax parser-symbol) - (:method (syntax (parser-symbol parser-symbol)) + (defgeneric ,name (view parser-symbol) + (:method (view (parser-symbol parser-symbol)) nil)) ,@(flet ((make-rule-exp (type args) (ecase type - (:face `#'(lambda (syntax parser-symbol) - (declare (ignore syntax parser-symbol)) - (make-drawing-options :face (make-face ,@args)))) - (:options `#'(lambda (syntax parser-symbol) - (declare (ignore syntax parser-symbol)) + (:face `(let ((options (make-drawing-options :face (make-face ,@args)))) + #'(lambda (view parser-symbol) + (declare (ignore view parser-symbol)) + options))) + (:options `#'(lambda (view parser-symbol) + (declare (ignore view parser-symbol)) (make-drawing-options ,@args))) (:function (first args))))) (loop for (parser-symbol (type . args)) in rules collect `(let ((rule ,(make-rule-exp type args))) - (defmethod ,name (syntax (parser-symbol ,parser-symbol)) - (funcall rule syntax parser-symbol))))))) + (defmethod ,name (view (parser-symbol ,parser-symbol)) + (funcall rule view parser-symbol))))))) (make-syntax-highlighting-rules default-syntax-highlighting) @@ -465,11 +466,13 @@ (:method ((syntax lr-syntax-mixin)) 'default-syntax-highlighting)) -(defun get-drawing-options (highlighting-rules syntax parse-symbol) +(defun get-drawing-options (highlighting-rules view parse-symbol) "Get the drawing options with which `parse-symbol' should be -drawn. If `parse-symbol' or the stack-top of syntax, return NIL." - (when (and parse-symbol (not (eq (stack-top syntax) parse-symbol))) - (funcall highlighting-rules syntax parse-symbol))) +drawn. If `parse-symbol' or the stack-top of syntax, return +NIL. `View' must be a `drei-syntax-view' containing a syntax that +`highlighting-rules' supports." + (when (and parse-symbol (not (eq (stack-top (syntax view)) parse-symbol))) + (funcall highlighting-rules view parse-symbol))) (defstruct (pump-state (:constructor make-pump-state @@ -493,7 +496,7 @@ (if (null parser-symbol) (cons (size (buffer view)) +default-drawing-options+) (let ((drawing-options - (get-drawing-options highlighting-rules syntax parser-symbol))) + (get-drawing-options highlighting-rules view parser-symbol))) (if (null drawing-options) (initial-drawing-options (parent parser-symbol)) (cons (end-offset parser-symbol) drawing-options)))))) @@ -502,7 +505,7 @@ (cons (1+ (size (buffer view))) +default-drawing-options+)) highlighting-rules)))) -(defun find-next-stroke-end (syntax pump-state) +(defun find-next-stroke-end (view pump-state) "Assuming that `pump-state' contains the previous pump state, find out where the next stroke should end, and possibly push some drawing options onto `pump-state'." @@ -511,7 +514,7 @@ (drawing-options pump-state-drawing-options) (highlighting-rules pump-state-highlighting-rules)) pump-state - (let ((line (line-containing-offset syntax offset))) + (let ((line (line-containing-offset (syntax view) offset))) (flet ((finish (offset symbol &optional stroke-drawing-options) (setf start-symbol symbol) (loop until (> (car (first drawing-options)) offset) @@ -530,7 +533,7 @@ (t (or (do-parse-symbols-forward (symbol offset start-symbol) (let ((symbol-drawing-options - (get-drawing-options highlighting-rules syntax symbol))) + (get-drawing-options highlighting-rules view symbol))) (cond ((> (start-offset symbol) (line-end-offset line)) (finish (line-end-offset line) start-symbol)) ((and (typep symbol 'literal-object-mixin)) @@ -564,7 +567,7 @@ (current-drawing-options pump-state-drawing-options)) pump-state (let ((old-drawing-options (cdr (first current-drawing-options))) - (end-offset (find-next-stroke-end syntax pump-state))) + (end-offset (find-next-stroke-end view pump-state))) (setf (stroke-start-offset stroke) offset (stroke-end-offset stroke) end-offset (stroke-drawing-options stroke) old-drawing-options

1 0

[mcclim-cvs] CVS mcclim/Extensions/Images
by thenriksen 07 Jan '08

07 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Extensions/Images In directory clnet:/tmp/cvs-serv27894/Extensions/Images Modified Files: gif.lisp Log Message: Handle GIF images with transparent parts. --- /project/mcclim/cvsroot/mcclim/Extensions/Images/gif.lisp 2008/01/06 08:36:57 1.1 +++ /project/mcclim/cvsroot/mcclim/Extensions/Images/gif.lisp 2008/01/07 14:18:15 1.2 @@ -26,10 +26,13 @@ (pattern-array (make-array (list (skippy:height first-image) (skippy:width first-image)))) (designs (coerce (loop with color-table = (skippy:color-table data-stream) - for i below 255 - collecting (multiple-value-bind (r g b) - (skippy:color-rgb (skippy:color-table-entry color-table i)) - (make-rgb-color (/ r 255) (/ g 255) (/ b 255)))) + for i below (skippy:color-table-size color-table) + when (= i (skippy:transparency-index first-image)) + collect +transparent-ink+ + else collect + (multiple-value-bind (r g b) + (skippy:color-rgb (skippy:color-table-entry color-table i)) + (make-rgb-color (/ r 255) (/ g 255) (/ b 255)))) 'vector))) (dotimes (y (array-dimension pattern-array 0)) (dotimes (x (array-dimension pattern-array 1))

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 07 Jan '08

07 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv15544/Drei Modified Files: drei-redisplay.lisp Log Message: Reduce the number of calls to DRAW-RECTANGLE*. Handle redisplay of strokes that have only had their drawing options changed (such as highlighted parentheses). Perhaps there is a need for a redisplay flag saying "I need to be drawn in a new position, but with the exact same output as before, so don't bother recomputing my size". --- /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/06 11:45:11 1.20 +++ /project/mcclim/cvsroot/mcclim/Drei/drei-redisplay.lisp 2008/01/07 13:30:55 1.21 @@ -436,22 +436,18 @@ (+ width cursor-x) (+ text-style-height cursor-y) baseline)))))) -(defun draw-stroke (stream view stroke cursor-x cursor-y line-height) +(defun draw-stroke (stream view stroke cursor-x cursor-y) "Draw `stroke' on `stream' at (`cursor-x', `cursor-y'). Nothing will be done unless `stroke' is dirty. Will use the function specified in the drawing-options of `stroke' to carry out the actual drawing." (let* ((drawing-options (stroke-drawing-options stroke))) + (unless (and (= cursor-x (x1 (stroke-dimensions stroke))) + (= cursor-y (y1 (stroke-dimensions stroke)))) + (invalidate-stroke stroke :modified t)) (when (stroke-dirty stroke) - (let ((old-dimensions (stroke-dimensions stroke))) - (with-accessors ((x1 x1) (y1 y1) (x2 x2) (y2 y2)) old-dimensions - (unless (or (= x1 y1 x2 y2 0)) - ;; Take care not to clear any previously drawn strokes. - (clear-rectangle* stream (max cursor-x x1) (max cursor-y y1) - (max x2 cursor-x) (+ (max (+ (max cursor-y y1) line-height) y2) - (stream-vertical-spacing stream)))) - (funcall (drawing-options-function drawing-options) stream view stroke - cursor-x cursor-y #'stroke-drawing-fn)))))) + (funcall (drawing-options-function drawing-options) stream view stroke + cursor-x cursor-y #'stroke-drawing-fn)))) (defun end-line (line x1 y1 line-width line-height) "End the addition of strokes to `line' for now, and update the @@ -520,7 +516,7 @@ for stroke-dimensions = (stroke-dimensions stroke) for pump-state = (put-stroke view line initial-pump-state) then (put-stroke view line pump-state) - do (draw-stroke stream view stroke cursor-x cursor-y line-height) + do (draw-stroke stream view stroke cursor-x cursor-y) (setf cursor-x (x2 stroke-dimensions)) maximizing (dimensions-height stroke-dimensions) into line-height summing (- (x2 stroke-dimensions)

1 0

[mcclim-cvs] CVS mcclim/Extensions/Images
by thenriksen 07 Jan '08

07 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Extensions/Images In directory clnet:/tmp/cvs-serv32595/Extensions/Images Modified Files: jpeg.lisp Log Message: Add "jpg" as synonym for "jpeg" image format. Use internal symbol JPEG::DECODE-IMAGE as CLJL only exports its symbols during compilation (???). --- /project/mcclim/cvsroot/mcclim/Extensions/Images/jpeg.lisp 2008/01/06 16:05:47 1.1 +++ /project/mcclim/cvsroot/mcclim/Extensions/Images/jpeg.lisp 2008/01/07 12:54:02 1.2 @@ -25,7 +25,7 @@ (define-image-reader "jpeg" (pathname) (with-open-file (stream pathname :direction :input) (multiple-value-bind (rgb height width) - (jpeg:decode-image stream) + (jpeg::decode-image stream) (let* ((rgb-image-data (make-array (list height width) :element-type '(unsigned-byte 32))) (rgb-image (make-instance 'clim-internals::rgb-image @@ -40,3 +40,6 @@ (dpb grey (byte 8 16) (dpb (- 255 0) (byte 8 24) 0)))))))) (clim-internals::make-rgb-image-design rgb-image))))) + +(define-image-reader "jpg" (pathname) + (load-image-of-format "jpeg" pathname))

1 0

[mcclim-cvs] CVS mcclim/Drei
by thenriksen 07 Jan '08

07 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Drei In directory clnet:/tmp/cvs-serv16397/Drei Modified Files: lisp-syntax.lisp Log Message: Added parenthesis highlighting for Lisp syntax. --- /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2008/01/05 21:07:16 1.52 +++ /project/mcclim/cvsroot/mcclim/Drei/lisp-syntax.lisp 2008/01/07 12:00:43 1.53 @@ -275,9 +275,10 @@ (defclass error-lexeme (lisp-lexeme) ()) (defclass literal-object-lexeme (lisp-lexeme literal-object-mixin) ()) (defclass literal-object-error-lexeme (lisp-lexeme literal-object-mixin) ()) -(defclass left-parenthesis-lexeme (lisp-lexeme) ()) +(defclass parenthesis-lexeme (lisp-lexeme) ()) +(defclass left-parenthesis-lexeme (parenthesis-lexeme) ()) (defclass simple-vector-start-lexeme (lisp-lexeme) ()) -(defclass right-parenthesis-lexeme (lisp-lexeme) ()) +(defclass right-parenthesis-lexeme (parenthesis-lexeme) ()) (defclass quote-lexeme (lisp-lexeme) ()) (defclass backquote-lexeme (lisp-lexeme) ()) (defclass comma-lexeme (lisp-lexeme) ()) @@ -1832,7 +1833,8 @@ (let ((keyword-drawing-options (make-drawing-options :face (make-face :ink +orchid+))) (macro-drawing-options (make-drawing-options :face (make-face :ink +purple+))) - (bound-drawing-options (make-drawing-options :face (make-face :ink +darkgoldenrod+)))) + (bound-drawing-options (make-drawing-options :face (make-face :ink +darkgoldenrod+))) + (highlighted-parenthesis-options (make-drawing-options :face (make-face :style (make-text-style nil :bold nil))))) (make-syntax-highlighting-rules emacs-style-highlighting (error-lexeme (:face :ink +red+)) (string-form (:face :ink +rosy-brown+ @@ -1846,7 +1848,15 @@ macro-drawing-options) ((symbol-form-is-boundp syntax form) bound-drawing-options) - (t +default-drawing-options+))))))) + (t +default-drawing-options+))))) + (parenthesis-lexeme (:function #'(lambda (syntax form) + (declare (ignore syntax)) + ;; XXX: Using (point) here may be hacky. + (if (and (or (mark= (point) (start-offset (parent form))) + (mark= (point) (end-offset (parent form)))) + (form-complete-p (parent form))) + highlighted-parenthesis-options + +default-drawing-options+)))))) (let ((macro-drawing-options (make-drawing-options :face (make-face :style (make-text-style nil :bold nil))))) (make-syntax-highlighting-rules retro-highlighting

1 0

[mcclim-cvs] CVS mcclim/Extensions/Images
by dlichteblau 06 Jan '08

06 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Extensions/Images In directory clnet:/tmp/cvs-serv16520/Extensions/Images Added Files: jpeg.lisp Log Message: - added jpeg.lisp by Eric Marsden and Troels Henriksen - changed rgb-image-design to invalidate the medium-specific cache automatically instead of being bound to one medium - added output recording for draw-design of an rgb-image-design --- /project/mcclim/cvsroot/mcclim/Extensions/Images/jpeg.lisp 2008/01/06 16:05:47 NONE +++ /project/mcclim/cvsroot/mcclim/Extensions/Images/jpeg.lisp 2008/01/06 16:05:47 1.1 ;;; -*- Mode: Lisp; Package: MCCLIM-IMAGES -*- ;;; (c) copyright 2008 ;;; Eric Marsden ;;; (c) copyright 2008 by ;;; Troels Henriksen (athas(a)sigkill.dk) ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Library General Public ;;; License as published by the Free Software Foundation; either ;;; version 2 of the License, or (at your option) any later version. ;;; ;;; This library is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;; Library General Public License for more details. ;;; ;;; You should have received a copy of the GNU Library General Public ;;; License along with this library; if not, write to the ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;;; Boston, MA 02111-1307 USA. (in-package :mcclim-images) (define-image-reader "jpeg" (pathname) (with-open-file (stream pathname :direction :input) (multiple-value-bind (rgb height width) (jpeg:decode-image stream) (let* ((rgb-image-data (make-array (list height width) :element-type '(unsigned-byte 32))) (rgb-image (make-instance 'clim-internals::rgb-image :width width :height height :alphap nil :data rgb-image-data))) (loop for y from (1- height) downto 0 do (loop for x from (1- width) downto 0 do (let ((grey (svref rgb (+ x (* y width))))) (setf (aref rgb-image-data y x) (dpb grey (byte 8 0) (dpb grey (byte 8 8) (dpb grey (byte 8 16) (dpb (- 255 0) (byte 8 24) 0)))))))) (clim-internals::make-rgb-image-design rgb-image)))))

1 0

[mcclim-cvs] CVS mcclim
by dlichteblau 06 Jan '08

06 Jan '08

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv16520 Modified Files: mcclim.asd Log Message: - added jpeg.lisp by Eric Marsden and Troels Henriksen - changed rgb-image-design to invalidate the medium-specific cache automatically instead of being bound to one medium - added output recording for draw-design of an rgb-image-design --- /project/mcclim/cvsroot/mcclim/mcclim.asd 2008/01/06 08:36:58 1.71 +++ /project/mcclim/cvsroot/mcclim/mcclim.asd 2008/01/06 16:05:46 1.72 @@ -574,7 +574,7 @@ `(progn ,@(loop for (format . depends-on) in formats collecting `(support-format ,format ,@depends-on)))) -(support-formats ("gif" :skippy) ("xpm")) +(support-formats ("gif" :skippy) ("xpm") ("jpeg" :cl-jpeg)) ;;; The actual McCLIM system that people should to use in their ASDF ;;; package dependency lists.

1 0

[mcclim-cvs] CVS mcclim/Extensions
by dlichteblau 06 Jan '08

06 Jan '08

Update of /project/mcclim/cvsroot/mcclim/Extensions In directory clnet:/tmp/cvs-serv16520/Extensions Modified Files: rgb-image.lisp Log Message: - added jpeg.lisp by Eric Marsden and Troels Henriksen - changed rgb-image-design to invalidate the medium-specific cache automatically instead of being bound to one medium - added output recording for draw-design of an rgb-image-design --- /project/mcclim/cvsroot/mcclim/Extensions/rgb-image.lisp 2007/04/01 17:24:04 1.2 +++ /project/mcclim/cvsroot/mcclim/Extensions/rgb-image.lisp 2008/01/06 16:05:46 1.3 @@ -43,14 +43,12 @@ ;;; medium, so that mediums can put their own data into them. (defclass rgb-image-design (design) - ((medium :initarg :medium) + ((medium :initform nil :initarg :medium) (image :initarg :image) (medium-data :initform nil))) -(defun make-rgb-image-design (medium image) - (make-instance 'rgb-image-design - :medium medium - :image image)) +(defun make-rgb-image-design (image) + (make-instance 'rgb-image-design :image image)) ;;; Protocol to free cached data @@ -65,8 +63,13 @@ (defgeneric medium-draw-image-design* (medium design x y)) -(defmethod medium-draw-image-design* :before (medium design x y) - (assert (eq medium (slot-value design 'medium)))) +(defmethod medium-draw-image-design* :before (current-medium design x y) + (with-slots (medium medium-data) design + (unless (eq medium current-medium) + (when medium + (medium-free-image-design medium design)) + (setf medium current-medium) + (setf medium-data nil)))) ;;; Fetching protocol @@ -88,3 +91,17 @@ :alphap alphap)))) (defgeneric sheet-rgb-data (port sheet &key x y width height)) + + +;;; Output recording + +(defun draw-image-design* + (medium design &rest options &key x y &allow-other-keys) + (unless (and x y) + (setf (values x y) (clim:stream-cursor-position medium))) + (climi::with-medium-options (medium options) + (medium-draw-image-design* (sheet-medium medium) design x y))) + +(defmethod draw-design + (medium (design rgb-image-design) &rest options &key &allow-other-keys) + (apply #'draw-image-design* medium design options))

1 0

← Newer
1
...
18
19
20
21
22
23
24
25
26
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

mcclim-cvs January 2008