[graphic-forms-cvs] r55 - in trunk/src: . tests/uitoolkit uitoolkit/graphics

[junrue at common-lisp.net]

Author: junrue
Date: Mon Mar 20 00:51:28 2006
New Revision: 55

Modified:
   trunk/src/packages.lisp
   trunk/src/tests/uitoolkit/event-tester.lisp
   trunk/src/tests/uitoolkit/hello-world.lisp
   trunk/src/tests/uitoolkit/windlg.lisp
   trunk/src/uitoolkit/graphics/color.lisp
   trunk/src/uitoolkit/graphics/graphics-context.lisp
Log:
changed color constants to be defvars not defconstants

Modified: trunk/src/packages.lisp
==============================================================================
--- trunk/src/packages.lisp	(original)
+++ trunk/src/packages.lisp	Mon Mar 20 00:51:28 2006
@@ -124,11 +124,11 @@
     #:transform
 
 ;; constants
-    #:+color-black+
-    #:+color-blue+
-    #:+color-green+
-    #:+color-red+
-    #:+color-white+
+    #:*color-black*
+    #:*color-blue*
+    #:*color-green*
+    #:*color-red*
+    #:*color-white*
 
 ;; methods, functions, macros
     #:alpha

Modified: trunk/src/tests/uitoolkit/event-tester.lisp
==============================================================================
--- trunk/src/tests/uitoolkit/event-tester.lisp	(original)
+++ trunk/src/tests/uitoolkit/event-tester.lisp	Mon Mar 20 00:51:28 2006
@@ -48,8 +48,8 @@
 
 (defmethod gfw:event-paint ((d event-tester-window-events) window time gc rect)
   (declare (ignorable time rect))
-  (setf (gfg:background-color gc) gfg:+color-white+)
-  (setf (gfg:foreground-color gc) gfg:+color-blue+)
+  (setf (gfg:background-color gc) gfg:*color-white*)
+  (setf (gfg:foreground-color gc) gfg:*color-blue*)
   (let* ((sz (gfw:client-size window))
          (pnt (gfi:make-point :x 0 :y (floor (/ (gfi:size-height sz) 2)))))
     (gfg:draw-text gc *event-tester-text* pnt)))

Modified: trunk/src/tests/uitoolkit/hello-world.lisp
==============================================================================
--- trunk/src/tests/uitoolkit/hello-world.lisp	(original)
+++ trunk/src/tests/uitoolkit/hello-world.lisp	Mon Mar 20 00:51:28 2006
@@ -46,10 +46,10 @@
   (declare (ignore time))
   (setf rect (make-instance 'gfi:rectangle :location (gfi:make-point)
                                            :size (gfw:client-size window)))
-  (setf (gfg:background-color gc) gfg:+color-white+)
+  (setf (gfg:background-color gc) gfg:*color-white*)
   (gfg:draw-filled-rectangle gc rect)
-  (setf (gfg:background-color gc) gfg:+color-red+)
-  (setf (gfg:foreground-color gc) gfg:+color-green+)
+  (setf (gfg:background-color gc) gfg:*color-red*)
+  (setf (gfg:foreground-color gc) gfg:*color-green*)
   (gfg:draw-text gc "Hello World!" (gfi:make-point)))
 
 (defun exit-fn (disp item time rect)

Modified: trunk/src/tests/uitoolkit/windlg.lisp
==============================================================================
--- trunk/src/tests/uitoolkit/windlg.lisp	(original)
+++ trunk/src/tests/uitoolkit/windlg.lisp	Mon Mar 20 00:51:28 2006
@@ -49,7 +49,7 @@
   (declare (ignore time))
   (setf rect (make-instance 'gfi:rectangle :location (gfi:make-point)
                                            :size (gfw:client-size window)))
-  (setf (gfg:background-color gc) gfg:+color-white+)
+  (setf (gfg:background-color gc) gfg:*color-white*)
   (gfg:draw-filled-rectangle gc rect))
 
 (defclass test-mini-events (test-win-events) ())

Modified: trunk/src/uitoolkit/graphics/color.lisp
==============================================================================
--- trunk/src/uitoolkit/graphics/color.lisp	(original)
+++ trunk/src/uitoolkit/graphics/color.lisp	Mon Mar 20 00:51:28 2006
@@ -34,12 +34,6 @@
 (in-package :graphic-forms.uitoolkit.graphics)
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (defconstant +color-black+ (make-color :red 0 :green 0 :blue 0))
-  (defconstant +color-blue+ (make-color :red 0 :green 0 :blue #xFF))
-  (defconstant +color-green+ (make-color :red 0 :green #xFF :blue 0))
-  (defconstant +color-red+ (make-color :red #xFF :green 0 :blue 0))
-  (defconstant +color-white+ (make-color :red #xFF :green #xFF :blue #xFF))
-
   (defmacro color-as-rgb (color)
     (let ((result (gensym)))
       `(let ((,result 0))
@@ -48,6 +42,12 @@
          (setf (ldb (byte 8 16) ,result) (color-blue ,color))
          ,result))))
 
+(defvar *color-black* (make-color :red 0 :green 0 :blue 0))
+(defvar *color-blue*  (make-color :red 0 :green 0 :blue #xFF))
+(defvar *color-green* (make-color :red 0 :green #xFF :blue 0))
+(defvar *color-red*   (make-color :red #xFF :green 0 :blue 0))
+(defvar *color-white* (make-color :red #xFF :green #xFF :blue #xFF))
+
 (defmethod print-object ((obj color) stream)
   (print-unreadable-object (obj stream :type t)
     (format stream "~a,~a,~a" (color-red obj) (color-green obj) (color-blue obj))))

Modified: trunk/src/uitoolkit/graphics/graphics-context.lisp
==============================================================================
--- trunk/src/uitoolkit/graphics/graphics-context.lisp	(original)
+++ trunk/src/uitoolkit/graphics/graphics-context.lisp	Mon Mar 20 00:51:28 2006
@@ -99,11 +99,13 @@
         (if (not (null (transparency-pixel-of im)))
           (let ((hmask (gfi:handle (transparency-mask im)))
                 (hcopy (clone-bitmap himage))
-                (memdc2 (gfs::create-compatible-dc (cffi:null-pointer))))
+                (memdc2 (gfs::create-compatible-dc (cffi:null-pointer)))
+                (black (make-color :red 0 :green 0 :blue 0))
+                (white (make-color :red #xFF :green #xFF :blue #xFF)))
             (gfs::select-object memdc hmask)
             (gfs::select-object memdc2 hcopy)
-            (gfs::set-bk-color memdc2 (color-as-rgb +color-black+))
-            (gfs::set-text-color memdc2 (color-as-rgb +color-white+))
+            (gfs::set-bk-color memdc2 (color-as-rgb black))
+            (gfs::set-text-color memdc2 (color-as-rgb white))
             (gfs::bit-blt memdc2
                           0 0
                           gfs::width