[graphic-forms-cvs] r233 - in trunk: . docs/website src/tests/uitoolkit
junrue at common-lisp.net
junrue at common-lisp.net
Tue Aug 22 22:38:08 UTC 2006
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.
More information about the Graphic-forms-cvs
mailing list