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