mcclim-cvs

mcclim-cvs@common-lisp.net

1697 discussions

[mcclim-cvs] CVS mcclim/Examples
by dlichteblau 07 May '06

07 May '06

Update of /project/mcclim/cvsroot/mcclim/Examples In directory clnet:/tmp/cvs-serv26624/Examples Modified Files: demodemo.lisp Added Files: drawing-benchmark.lisp Log Message: Medium benchmark toy. * mcclim.asd (clim-examples): Added drawing-benchmark.lisp. * Examples/drawing-benchmark.lisp: New file. * Examples/demodemo.lisp (demodemo): Added Drawing Benchmark button. * Backends/gtkairo/port.lisp (port-force-output): Call gdk_flush. --- /project/mcclim/cvsroot/mcclim/Examples/demodemo.lisp 2006/04/17 17:54:58 1.10 +++ /project/mcclim/cvsroot/mcclim/Examples/demodemo.lisp 2006/05/07 19:47:19 1.11 @@ -73,7 +73,9 @@ (make-demo-button "Scroll Test" 'Scroll-test) (make-demo-button "List Test" 'list-test) (make-demo-button "HBOX Test" 'hbox-test) - (make-demo-button "Text Size Test" 'text-size-test))))))))) + (make-demo-button "Text Size Test" 'text-size-test) + (make-demo-button "Drawing Benchmark" + 'drawing-benchmark))))))))) (defun demodemo () #+nil --- /project/mcclim/cvsroot/mcclim/Examples/drawing-benchmark.lisp 2006/05/07 19:47:19 NONE +++ /project/mcclim/cvsroot/mcclim/Examples/drawing-benchmark.lisp 2006/05/07 19:47:19 1.1 ;;; -*- Mode: Lisp; -*- ;;; (c) 2006 David Lichteblau (david(a)lichteblau.com) ;;; 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 :clim-demo) (define-application-frame drawing-benchmark () () (:panes (canvas :application :min-width 600 :incremental-redisplay nil :display-time nil) (mode (with-radio-box () (radio-box-current-selection (make-pane 'toggle-button :label "rectangle" :id :rectangle)) (make-pane 'toggle-button :label "text" :id :text))) (ink (with-radio-box () (radio-box-current-selection (make-pane 'toggle-button :label "random" :id :random)) (make-pane 'toggle-button :label "red" :id +red+) (make-pane 'toggle-button :label "flipping ink" :id +flipping-ink+)))) (:layouts (default (vertically () (horizontally () (labelling (:label "Mode") mode) (labelling (:label "Ink") ink)) canvas)))) (defmethod run-drawing-benchmark (frame stream) (setf (stream-recording-p stream) nil) (window-clear stream) (let* ((width (rectangle-width (sheet-region stream))) (height (rectangle-height (sheet-region stream))) (mode (gadget-id (gadget-value (find-pane-named frame 'mode)))) (ink (gadget-id (gadget-value (find-pane-named frame 'ink)))) (itups internal-time-units-per-second) (n 0) (start (get-internal-real-time)) (stop (+ start itups))) (do () ((>= (get-internal-real-time) stop)) (incf n) (let ((ink (if (eq ink :random) (clim:make-rgb-color (random 1.0d0) (random 1.0d0) (random 1.0d0)) ink))) (ecase mode (:rectangle (draw-rectangle* stream 10 10 (- width 10) (- height 10) :ink ink :filled t)) (:text (dotimes (x 10) (draw-text* stream "Bla blub hastenichgesehen noch viel mehr Text so fuellen wir eine Zeile." 0 (* x 20) :ink ink)))))) (finish-output stream) (medium-finish-output (sheet-medium stream)) (climi::port-force-output (car climi::*all-ports*)) (setf stop (get-internal-real-time)) (window-clear stream) (setf (stream-recording-p stream) t) (format stream "Score: ~A operations/s~%" (float (/ n (/ (- stop start) itups)))))) (define-drawing-benchmark-command (com-quit-drawing-benchmark :menu "Quit") () (frame-exit *application-frame*)) (define-drawing-benchmark-command (com-update :menu "Run") () (run-drawing-benchmark *application-frame* (frame-standard-output *application-frame*)))

1 0

[mcclim-cvs] CVS mcclim
by dlichteblau 07 May '06

07 May '06

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv26624 Modified Files: mcclim.asd Log Message: Medium benchmark toy. * mcclim.asd (clim-examples): Added drawing-benchmark.lisp. * Examples/drawing-benchmark.lisp: New file. * Examples/demodemo.lisp (demodemo): Added Drawing Benchmark button. * Backends/gtkairo/port.lisp (port-force-output): Call gdk_flush. --- /project/mcclim/cvsroot/mcclim/mcclim.asd 2006/04/23 12:57:31 1.20 +++ /project/mcclim/cvsroot/mcclim/mcclim.asd 2006/05/07 19:47:19 1.21 @@ -339,7 +339,8 @@ (:file "method-browser") (:file "dragndrop-translator") (:file "draggable-graph") - (:file "text-size-test"))) + (:file "text-size-test") + (:file "drawing-benchmark"))) (:module "Goatee" :components ((:file "goatee-test")))))

1 0

[mcclim-cvs] CVS mcclim/Backends/gtkairo
by dlichteblau 07 May '06

07 May '06

Update of /project/mcclim/cvsroot/mcclim/Backends/gtkairo In directory clnet:/tmp/cvs-serv18990 Modified Files: BUGS Log Message: more bugs --- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/BUGS 2006/05/02 13:00:12 1.8 +++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/BUGS 2006/05/07 14:33:04 1.9 @@ -62,7 +62,7 @@ The new flipping ink implementation is buggy, it produces garbage output in some cases. -12. +(FIXED) 12. In the address book, there are often wide grey borders instead of the narrow black ones. @@ -95,3 +95,11 @@ pixmap just large enough for the clipping region and the currently visible part of a (scrolled) sheet. Right now we're copying the entire window around, which seems excessive. + +19. + Key press events for modifier keys don't have the corresponding + modifier bit set; key release events do. This is opposite to what + CLIM-CLX does. + +20. + Very nasty duplicate keyboard events when typing in the listener.

1 0

[mcclim-cvs] CVS mcclim/Backends/gtkairo
by dlichteblau 07 May '06

07 May '06

Update of /project/mcclim/cvsroot/mcclim/Backends/gtkairo In directory clnet:/tmp/cvs-serv18841 Modified Files: gtk-ffi.lisp Log Message: * gtk-ffi.lisp: #+darwin library loading, thanks to Cyrus Harmon. --- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gtk-ffi.lisp 2006/05/02 13:00:12 1.5 +++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gtk-ffi.lisp 2006/05/07 14:30:24 1.6 @@ -19,12 +19,20 @@ (in-package :clim-gtkairo) -#-(or win32 mswindows windows) +#-(or win32 mswindows windows darwin) (eval-when (:compile-toplevel :load-toplevel :execute) (cffi:load-foreign-library "libcairo.so") (cffi:load-foreign-library "libgthread-2.0.so") (cffi:load-foreign-library "libgtk-x11-2.0.so")) +#+darwin +(eval-when (:compile-toplevel :load-toplevel :execute) + (let ((cffi:*foreign-library-directories* + (cons "/opt/local/lib/" cffi:*foreign-library-directories*))) + (cffi:load-foreign-library "libcairo.dylib") + (cffi:load-foreign-library "libgthread-2.0.dylib") + (cffi:load-foreign-library "libgtk-x11-2.0.dylib"))) + #+(or win32 mswindows windows) (eval-when (:compile-toplevel :load-toplevel :execute) (cffi:load-foreign-library "libcairo-2.dll")

1 0

[mcclim-cvs] CVS mcclim/Backends/gtkairo
by dlichteblau 07 May '06

07 May '06

Update of /project/mcclim/cvsroot/mcclim/Backends/gtkairo In directory clnet:/tmp/cvs-serv17296 Modified Files: event.lisp Log Message: Minor key event correction, still not quite there. I'd like to make this work without having to pull in clx/keysyms.lisp. * event.lisp (key-handler): Don't give :escape a character. Actually, CLX will return #\escape here on #+(or lispm excl), but it doesn't do that anywhere else and NIL is certainly better than #\{, which we used to return. --- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/event.lisp 2006/05/02 13:00:11 1.6 +++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/event.lisp 2006/05/07 14:29:06 1.7 @@ -194,11 +194,13 @@ (char string 0))) (sym (gethash keyval *keysyms*))) ;; McCLIM will #\a statt ^A sehen: - (when (and char - (< 0 (char-code char) 32) - ;; ...aber fuer return dann auf einmal doch - (not (eql char #\return))) - (setf char (code-char (+ (char-code char) 96)))) + (cond + ((null char)) + ((eql char #\return)) + ((eql char #\escape) + (setf char nil)) + ((< 0 (char-code char) 32) + (setf char (code-char (+ (char-code char) 96))))) (when (eq sym :backspace) (setf char #\backspace)) ;; irgendwas sagt mir, dass hier noch weitere Korrekturen

1 0

[mcclim-cvs] CVS mcclim
by crhodes 03 May '06

03 May '06

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv24921 Modified Files: incremental-redisplay.lisp Log Message: Delete definitely not needed method. --- /project/mcclim/cvsroot/mcclim/incremental-redisplay.lisp 2006/05/03 09:33:08 1.61 +++ /project/mcclim/cvsroot/mcclim/incremental-redisplay.lisp 2006/05/03 09:39:06 1.62 @@ -434,12 +434,6 @@ (let ((state (end-graphics-state record))) (setf (values (cursor-x state) (cursor-y state)) (values x y)))) -;;; XXX still needed? -(defmethod add-output-record :after - ((child updating-output-record-mixin) record) - (declare (ignore record child))) - - ;;; Prevent deleted output records from coming back from the dead. (defmethod delete-output-record :after ((child updating-output-record-mixin) record

1 0

[mcclim-cvs] CVS mcclim
by afuchs 03 May '06

03 May '06

Update of /project/mcclim/cvsroot/mcclim In directory clnet:/tmp/cvs-serv24588 Modified Files: incremental-redisplay.lisp Log Message: Fix incremental-redisplay memory leak by removing the children-updating-output slot and related bookkeeping code. --- /project/mcclim/cvsroot/mcclim/incremental-redisplay.lisp 2006/04/22 15:31:27 1.60 +++ /project/mcclim/cvsroot/mcclim/incremental-redisplay.lisp 2006/05/03 09:33:08 1.61 @@ -387,9 +387,6 @@ (stream :accessor updating-output-stream :initarg :stream :initform nil :documentation "Capture the screen in order to restrict update to visible records") - (children-updating-output :accessor children-updating-output :initform nil - :documentation "A list of updating-output records -that are children (but not necessarily direct) of this record.") (parent-updating-output :accessor parent-updating-output :initarg :parent-updating-output :initform nil :documentation "A backlink to the @@ -440,10 +437,7 @@ ;;; XXX still needed? (defmethod add-output-record :after ((child updating-output-record-mixin) record) - (declare (ignore record)) - (if (parent-updating-output child) - (push child (children-updating-output (parent-updating-output child))) - nil)) + (declare (ignore record child))) ;;; Prevent deleted output records from coming back from the dead. @@ -451,15 +445,10 @@ record &optional errorp) (declare (ignore record errorp)) - (let ((pcache (parent-cache child)) - (parent-updating (parent-updating-output child))) + (let ((pcache (parent-cache child))) (delete-from-map pcache (output-record-unique-id child) - (output-record-id-test child)) - (when parent-updating - (setf (children-updating-output parent-updating) - (delete child (children-updating-output parent-updating) - :test #'eq))))) + (output-record-id-test child)))) (defclass standard-updating-output-record (updating-output-record-mixin

1 0

[mcclim-cvs] CVS mcclim/Experimental/freetype
by crhodes 02 May '06

02 May '06

Update of /project/mcclim/cvsroot/mcclim/Experimental/freetype In directory clnet:/tmp/cvs-serv14348 Modified Files: freetype-ffi.lisp Log Message: In sbcl, load the versioned shared object --- /project/mcclim/cvsroot/mcclim/Experimental/freetype/freetype-ffi.lisp 2006/03/15 22:56:55 1.4 +++ /project/mcclim/cvsroot/mcclim/Experimental/freetype/freetype-ffi.lisp 2006/05/02 15:46:42 1.5 @@ -57,7 +57,7 @@ `(def-alien-routine ,@rest)) #+sbcl -(load-shared-object #+darwin "/usr/X11R6/lib/libfreetype.dylib" #-darwin "libfreetype.so") +(load-shared-object #+darwin "/usr/X11R6/lib/libfreetype.6.dylib" #-darwin "libfreetype.so.6") (declaim (optimize (speed 3)))

1 0

[mcclim-cvs] CVS mcclim/Backends/gtkairo
by dlichteblau 02 May '06

02 May '06

Update of /project/mcclim/cvsroot/mcclim/Backends/gtkairo In directory clnet:/tmp/cvs-serv26810 Modified Files: clim-fix.lisp Log Message: ... and this turned out to be a similar but unrelated display glitch: * clim-fix.lisp (handle-repaint): Restored the first version of this method form Gilbert's original clim-fix.lisp, which draws background ink before each repaint. Doesn't seem elegant, but DEMODEMO wants it. --- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/clim-fix.lisp 2006/04/30 09:24:40 1.3 +++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/clim-fix.lisp 2006/05/02 13:02:09 1.4 @@ -24,8 +24,20 @@ ;;; :design design) ;;; (call-next-method)) -(defmethod clim:handle-repaint :after ((s clim:sheet-with-medium-mixin) r) - (medium-force-output (sheet-medium s))) +(defmethod clim:handle-repaint :around ((s clim:sheet-with-medium-mixin) r) + (let ((m (clim:sheet-medium s)) + (r (clim:bounding-rectangle + (clim:region-intersection r (clim:sheet-region s))))) + (unless (eql r clim:+nowhere+) + ;; Test case: Start CLIM-DEMO::DEMODEMO and watch the header string. + ;; At the beginning, the text is nicely antialiased. Then start any + ;; demo and move the new window around over the header. As the + ;; header gets exposed again, the text is apparently redrawn + ;; multiple times and looks like crap. This fixes it: + (clim:with-drawing-options (m :clipping-region r) + (clim:draw-design m r :ink clim:+background-ink+) + (call-next-method s r))) + (medium-force-output m))) ;; cairo hack: adjust rectangle coordinates by half a pixel each to avoid ;; anti-aliasing (and follow-up output artifacts)

1 0

[mcclim-cvs] CVS mcclim/Backends/gtkairo
by dlichteblau 02 May '06

02 May '06

Update of /project/mcclim/cvsroot/mcclim/Backends/gtkairo In directory clnet:/tmp/cvs-serv25592 Modified Files: event.lisp gtk-ffi.lisp BUGS Log Message: Fixed those phantom gtkairo display glitches: * event.lisp (expose-handler): Clear the affected area using gdk. * gtk-ffi.lisp (gdk_window_clear_area): New function. --- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/event.lisp 2006/05/01 21:21:39 1.5 +++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/event.lisp 2006/05/02 13:00:11 1.6 @@ -130,6 +130,7 @@ (define-signal expose-handler (widget event) (enqueue (cffi:with-foreign-slots ((x y width height) event gdkeventexpose) + (gdk_window_clear_area (gtkwidget-gdkwindow widget) x y width height) (make-instance 'window-repaint-event :timestamp (get-internal-real-time) :sheet (widget->sheet widget *port*) --- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gtk-ffi.lisp 2006/04/23 17:36:28 1.4 +++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gtk-ffi.lisp 2006/05/02 13:00:12 1.5 @@ -674,6 +674,14 @@ (window :pointer) (title :string)) +(defcfun "gdk_window_clear_area" + :void + (window :pointer) + (x :int) + (y :int) + (width :int) + (height :int)) + (defconstant GDK_EXPOSURE_MASK (ash 1 1)) (defconstant GDK_POINTER_MOTION_MASK (ash 1 2)) (defconstant GDK_POINTER_MOTION_HINT_MASK (ash 1 3)) --- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/BUGS 2006/05/01 21:21:38 1.7 +++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/BUGS 2006/05/02 13:00:12 1.8 @@ -46,7 +46,7 @@ The frontend specifies background colors (*3d-normal-color*) where the gtk theme should take precedence. -9. +(FIXED) 9. Sometimes repaint seems to draw again without clearing the window first. For example, the header in demodemo gets darker with every repaint, until the originally antialiased text looks really crappy.

1 0

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