Author: junrue Date: Tue Aug 22 18:38:07 2006 New Revision: 233 Added: trunk/src/tests/uitoolkit/computer.png (contents, props changed) trunk/src/tests/uitoolkit/open-folder.gif (contents, props changed) Modified: trunk/NEWS.txt trunk/README.txt trunk/docs/website/index.html trunk/src/tests/uitoolkit/image-tester.lisp Log: added gif and png testcases to image-tester Modified: trunk/NEWS.txt ============================================================================== --- trunk/NEWS.txt (original) +++ trunk/NEWS.txt Tue Aug 22 18:38:07 2006 @@ -5,10 +5,10 @@ Here is what's new in this release: -. SBCL is now supported (version 0.9.15 tested). Graphic-Forms includes - a small patch provided to the SBCL community by Alastair Bridgewater - to enable the stdcall calling convention for alien callbacks. Please - see src/external-libraries/sbcl-callback-patch +. SBCL is now supported (specifically version 0.9.15). Graphic-Forms + includes a small patch provided to the SBCL community by + Alastair Bridgewater to enable the stdcall calling convention for + alien callbacks. Please see src/external-libraries/sbcl-callback-patch . Implemented a plugin mechanism for integrating graphics libraries. This means that ImageMagick is now optional -- if your application can get Modified: trunk/README.txt ============================================================================== --- trunk/README.txt (original) +++ trunk/README.txt Tue Aug 22 18:38:07 2006 @@ -66,7 +66,9 @@ supporting Windows, and as a consequence, you may experience problems such as 'GC invariant lost' errors that result in a crash to LDB. -3. The gfg:text-extent method currently does not return the correct text +3. The 'unblocked' and 'textedit' demo programs are not yet complete. + +4. The gfg:text-extent method currently does not return the correct text height value. As a workaround, get the text metrics for the font and compute height from that. The gfg:text-extent function does return the correct width. Modified: trunk/docs/website/index.html ============================================================================== --- trunk/docs/website/index.html (original) +++ trunk/docs/website/index.html Tue Aug 22 18:38:07 2006 @@ -53,7 +53,7 @@ <h3>Status</h3> <p>The current version is - <a href="http://prdownloads.sourceforge.net/graphic-forms/graphic-forms-0.5.0.zip?download"> + <a href="http://sourceforge.net/project/showfiles.php?group_id=163034"> 0.5.0</a>, released on 25 August 2006.</p> <p>Graphic-Forms is in the alpha stage of development, meaning new features are still being added and existing features require @@ -64,7 +64,7 @@ <ul> <li><a href="http://clisp.cons.org/">CLISP 2.38 or later</a></li> <li><a href="http://www.lispworks.com/">LispWorks 4.4.6</a></li> - <li><a href="http://sbcl.sourceforge.net/">SBCL 0.9.15 or later</a></li> + <li><a href="http://sbcl.sourceforge.net/">SBCL 0.9.15</a></li> </ul> <p>The supported Windows versions are: Added: trunk/src/tests/uitoolkit/computer.png ============================================================================== Binary file. No diff available. Modified: trunk/src/tests/uitoolkit/image-tester.lisp ============================================================================== --- trunk/src/tests/uitoolkit/image-tester.lisp (original) +++ trunk/src/tests/uitoolkit/image-tester.lisp Tue Aug 22 18:38:07 2006 @@ -33,20 +33,20 @@ (in-package #:graphic-forms.uitoolkit.tests) -(defvar *image-win* nil) -(defvar *happy-image* nil) -(defvar *bw-image* nil) -(defvar *true-image* nil) +(defvar *image-win* nil) +(defvar *happy-image* nil) +(defvar *bw-image* nil) +(defvar *comp-image* nil) +(defvar *folder-image* nil) +(defvar *true-image* nil) (defclass image-events (gfw:event-dispatcher) ()) (defun dispose-images () - (gfs:dispose *happy-image*) - (setf *happy-image* nil) - (gfs:dispose *bw-image*) - (setf *bw-image* nil) - (gfs:dispose *true-image*) - (setf *true-image* nil)) + (loop for var in '(*happy-image* *bw-image* *folder-image* *true-image* *comp-image*) + do (unless (null (symbol-value var)) + (gfs:dispose (symbol-value var)) + (setf (symbol-value var) nil)))) (defmethod gfw:event-close ((d image-events) window) (declare (ignore window)) @@ -55,36 +55,36 @@ (setf *image-win* nil) (gfw:shutdown 0)) +(defun draw-test-image (gc image origin pixel-pnt) + (gfg:draw-image gc image origin) + (incf (gfs:point-x origin) 36) + (gfg:with-image-transparency (image pixel-pnt) + (gfg:draw-image gc (gfg:transparency-mask image) origin) + (incf (gfs:point-x origin) 36) + (gfg:draw-image gc image origin))) + (defmethod gfw:event-paint ((d image-events) window gc rect) (declare (ignore window rect)) (let ((pnt (gfs:make-point)) (pixel-pnt1 (gfs:make-point)) - (pixel-pnt2 (gfs:make-point :x 0 :y 15))) - - (gfg:draw-image gc *happy-image* pnt) - (incf (gfs:point-x pnt) 36) - (gfg:with-image-transparency (*happy-image* pixel-pnt1) - (gfg:draw-image gc (gfg:transparency-mask *happy-image*) pnt) - (incf (gfs:point-x pnt) 36) - (gfg:draw-image gc *happy-image* pnt)) - + (pixel-pnt2 (gfs:make-point :x 15 :y 0)) + (pixel-pnt3 (gfs:make-point :x 31 :y 31))) + (declare (ignorable pixel-pnt3)) + (draw-test-image gc *happy-image* pnt pixel-pnt1) (setf (gfs:point-x pnt) 0) (incf (gfs:point-y pnt) 36) - (gfg:draw-image gc *bw-image* pnt) - (incf (gfs:point-x pnt) 24) - (gfg:with-image-transparency (*bw-image* pixel-pnt1) - (gfg:draw-image gc (gfg:transparency-mask *bw-image*) pnt) - (incf (gfs:point-x pnt) 24) - (gfg:draw-image gc *bw-image* pnt)) - + (draw-test-image gc *bw-image* pnt pixel-pnt1) (setf (gfs:point-x pnt) 0) - (incf (gfs:point-y pnt) 20) - (gfg:draw-image gc *true-image* pnt) - (incf (gfs:point-x pnt) 20) - (gfg:with-image-transparency (*true-image* pixel-pnt2) - (gfg:draw-image gc (gfg:transparency-mask *true-image*) pnt) - (incf (gfs:point-x pnt) 20) - (gfg:draw-image gc *true-image* pnt)))) + (incf (gfs:point-y pnt) 36) + (draw-test-image gc *true-image* pnt pixel-pnt2) +#+load-imagemagick-plugin + (progn + (setf (gfs:point-x pnt) 112) + (setf (gfs:point-y pnt) 0) + (draw-test-image gc *folder-image* pnt pixel-pnt1) + (setf (gfs:point-x pnt) 112) + (incf (gfs:point-y pnt) 36) + (draw-test-image gc *comp-image* pnt pixel-pnt3)))) (defun exit-image-fn (disp item) (declare (ignorable disp item)) @@ -93,15 +93,24 @@ (setf *image-win* nil) (gfw:shutdown 0)) +(defun load-images () + (let ((*default-pathname-defaults* (parse-namestring gfsys::*gf-tests-dir*))) + (setf *happy-image* (make-instance 'gfg:image)) + (gfg::load *happy-image* "happy.bmp") + (setf *bw-image* (make-instance 'gfg:image)) + (gfg::load *bw-image* "blackwhite20x16.bmp") + (setf *true-image* (make-instance 'gfg:image)) + (gfg::load *true-image* "truecolor16x16.bmp") +#+load-imagemagick-plugin + (progn + (setf *folder-image* (make-instance 'gfg:image)) + (gfg::load *folder-image* "open-folder.gif") + (setf *comp-image* (make-instance 'gfg:image)) + (gfg::load *comp-image* "computer.png")))) + (defun image-tester-internal () - (setf *default-pathname-defaults* (parse-namestring gfsys::*gf-tests-dir*)) + (load-images) (let ((menubar nil)) - (setf *happy-image* (make-instance 'gfg:image)) - (setf *bw-image* (make-instance 'gfg:image)) - (setf *true-image* (make-instance 'gfg:image)) - (gfg::load *happy-image* "happy.bmp") - (gfg::load *bw-image* "blackwhite20x16.bmp") - (gfg::load *true-image* "truecolor16x16.bmp") (setf *image-win* (make-instance 'gfw:top-level :dispatcher (make-instance 'image-events) :style '(:workspace))) (setf (gfw:size *image-win*) (gfs:make-size :width 250 :height 200)) Added: trunk/src/tests/uitoolkit/open-folder.gif ============================================================================== Binary file. No diff available.