[pal-cvs] CVS pal-gui
tneste
tneste at common-lisp.net
Tue Oct 30 20:44:46 UTC 2007
Update of /project/pal/cvsroot/pal-gui
In directory clnet:/tmp/cvs-serv32566
Modified Files:
gob.lisp gui.lisp package.lisp present.lisp widgets.lisp
Log Message:
GET-MIN-HEIGHT/WIDTH didn't work under CLisp, fixed.
Widgets now use PAL:COLOR structure where appropriate.
--- /project/pal/cvsroot/pal-gui/gob.lisp 2007/10/30 00:20:41 1.13
+++ /project/pal/cvsroot/pal-gui/gob.lisp 2007/10/30 20:44:46 1.14
@@ -1,5 +1,8 @@
(in-package :pal-gui)
+(declaim (optimize (speed 3)))
+
+
(defvar *root* nil)
(defvar *drag-start-pos* nil)
(defvar *relative-drag-start-pos* nil)
@@ -181,9 +184,10 @@
(pack parent))
(defmethod min-width-of ((g v-packing))
- (+ (loop for c in (childs-of g) maximizing (min-width-of c))
- (gap-of g)
- (* 2 (x-pad-of g))))
+ (let ((childs-min (loop for c in (childs-of g) maximizing (min-width-of c))))
+ (+ (if childs-min childs-min 0)
+ (gap-of g)
+ (* 2 (x-pad-of g)))))
(defmethod min-height-of ((g v-packing))
(+ (* (1- (length (childs-of g))) (gap-of g))
@@ -218,9 +222,10 @@
())
(defmethod min-height-of ((g h-packing))
- (+ (loop for c in (childs-of g) maximizing (min-height-of c))
- (gap-of g)
- (* 2 (y-pad-of g))))
+ (let ((childs-min (loop for c in (childs-of g) maximizing (min-height-of c))))
+ (+ (if childs-min childs-min 0)
+ (gap-of g)
+ (* 2 (y-pad-of g)))))
(defmethod min-width-of ((g h-packing))
(+ (* (1- (length (childs-of g))) (gap-of g))
--- /project/pal/cvsroot/pal-gui/gui.lisp 2007/10/30 00:20:41 1.9
+++ /project/pal/cvsroot/pal-gui/gui.lisp 2007/10/30 20:44:46 1.10
@@ -1,5 +1,56 @@
(in-package :pal-gui)
+(declaim (optimize (speed 3)))
+
+
+
+(defun config-gui (&key (font *gui-font*) (window-color *window-color*) (widget-color *widget-color*)
+ (paper-color *paper-color*) (tooltip-delay *tooltip-delay*) (text-color *text-color*))
+ (setf *gui-font* font
+ *window-color* window-color
+ *widget-color* widget-color
+ *text-color* text-color
+ *paper-color* paper-color
+ *tooltip-delay* tooltip-delay
+ *m* (truncate (* (get-font-height *gui-font*) 1.5))
+ *text-offset* (let ((fh (get-font-height *gui-font*)))
+ (v (truncate fh 2) (truncate fh 4)))))
+
+(defun update-gui ()
+ "Like PAL:UPDATE but also updates the GUI"
+ (pal::close-quads)
+ (reset-blend)
+ (pal-ffi:gl-load-identity)
+ (repaint *root*)
+ (update-screen))
+
+
+(defun active-gobs-at-point (point parent)
+ (let ((c (find-if (lambda (c)
+ (point-inside-p c point))
+ (reverse (childs-of parent)))))
+ (if c
+ (if (activep c)
+ (cons c (active-gobs-at-point point c))
+ (active-gobs-at-point point c))
+ nil)))
+
+(defun init-gui ()
+ (setf *root* (make-instance 'root :parent nil)
+ *gui-font* (tag 'pal::default-font)
+ *drag-start-pos* nil
+ *relative-drag-start-pos* nil
+ *focused-gob* nil
+ *pointed-gob* nil
+ *armed-gob* nil)
+ (config-gui :font (tag 'pal::default-font)
+ :window-color (color 140 140 140 160)
+ :widget-color (color 180 180 180 128)
+ :text-color (color 0 0 0 255)
+ :paper-color (color 255 255 200 255)
+ :tooltip-delay 1))
+
+
(defmacro gui-loop ((&key key-up-fn key-down-fn mouse-motion-fn quit-fn) &body redraw)
"Same as PAL:EVENT-LOOP but with added GUI event handling"
@@ -58,36 +109,4 @@
(init-gui)
(unwind-protect
(progn , at body)
- (close-pal))))
-
-
-(defun active-gobs-at-point (point parent)
- (let ((c (find-if (lambda (c)
- (point-inside-p c point))
- (reverse (childs-of parent)))))
- (if c
- (if (activep c)
- (cons c (active-gobs-at-point point c))
- (active-gobs-at-point point c))
- nil)))
-
-(defun init-gui ()
- (setf *root* (make-instance 'root :parent nil)
- *gui-font* (tag 'pal::default-font)
- *drag-start-pos* nil
- *relative-drag-start-pos* nil
- *focused-gob* nil
- *pointed-gob* nil
- *armed-gob* nil))
-
-(defun update-gui ()
- "Like PAL:UPDATE but also updates the GUI"
- (pal::close-quads)
- (reset-blend)
- (pal-ffi:gl-load-identity)
- (repaint *root*)
- (update-screen))
-
-(defun set-gui-font (font)
- (assert (font-p font))
- (setf *gui-font* font))
\ No newline at end of file
+ (close-pal))))
\ No newline at end of file
--- /project/pal/cvsroot/pal-gui/package.lisp 2007/10/30 00:20:41 1.4
+++ /project/pal/cvsroot/pal-gui/package.lisp 2007/10/30 20:44:46 1.5
@@ -1,6 +1,6 @@
(defpackage #:pal-gui
(:use :common-lisp :pal)
- (:export #:with-gui #:init-gui #:update-gui #:gui-loop #:set-gui-font
+ (:export #:with-gui #:init-gui #:update-gui #:gui-loop #:config-gui
#:present
--- /project/pal/cvsroot/pal-gui/present.lisp 2007/10/29 20:06:01 1.2
+++ /project/pal/cvsroot/pal-gui/present.lisp 2007/10/30 20:44:46 1.3
@@ -1,12 +1,9 @@
(in-package :pal-gui)
-(defgeneric present (object gob width height))
-
-
(defmethod present (object (g widget) width height)
(with-blend (:color *text-color*)
- (draw-text (format nil "~a" object) (v (vx (get-text-offset))
+ (draw-text (format nil "~a" object) (v (vx *text-offset*)
(- (truncate height 2) (truncate (get-font-height *gui-font*) 2) 1)))))
@@ -20,33 +17,33 @@
(draw-polygon (list (v 3 (- height 3))
(v (/ width 2) 3)
(v (- width 3) (- height 3)))
- (first *text-color*) (second *text-color*) (third *text-color*)(fourth *text-color*) :smoothp t))
+ (color-r *text-color*) (color-g *text-color*) (color-b *text-color*)(color-a *text-color*) :smoothp t))
(defmethod present ((s (eql :down-arrow)) (g widget) width height)
(draw-polygon (list (v 3 3)
(v (/ width 2) (- height 3))
(v (- width 3) 3))
- (first *text-color*) (second *text-color*) (third *text-color*)(fourth *text-color*) :smoothp t))
+ (color-r *text-color*) (color-g *text-color*) (color-b *text-color*)(color-a *text-color*) :smoothp t))
(defmethod present ((s (eql :right-arrow)) (g widget) width height)
(draw-polygon (list (v 3 3)
(v (- width 3) (/ height 2))
(v 3 (- height 3)))
- (first *text-color*) (second *text-color*) (third *text-color*)(fourth *text-color*) :smoothp t))
+ (color-r *text-color*) (color-g *text-color*) (color-b *text-color*)(color-a *text-color*) :smoothp t))
(defmethod present ((s (eql :left-arrow)) (g widget) width height)
(draw-polygon (list (v (- width 3) 3)
(v 3 (/ height 2))
(v (- width 3) (- height 3)))
- (first *text-color*) (second *text-color*) (third *text-color*)(fourth *text-color*) :smoothp t))
+ (color-r *text-color*) (color-g *text-color*) (color-b *text-color*)(color-a *text-color*) :smoothp t))
(defmethod present ((s (eql :box)) (g widget) width height)
- (draw-rectangle (v 3 3) (- width 6) (- height 6) (first *text-color*) (second *text-color*) (third *text-color*)(fourth *text-color*) :smoothp t))
+ (draw-rectangle (v 3 3) (- width 6) (- height 6) (color-r *text-color*) (color-g *text-color*) (color-b *text-color*)(color-a *text-color*) :smoothp t))
(defmethod present ((s (eql :circle)) (g widget) width height)
- (draw-circle (v (/ width 2) (/ height 2)) (/ (min width height) pi) (first *text-color*) (second *text-color*) (third *text-color*)(fourth *text-color*) :smoothp t))
+ (draw-circle (v (/ width 2) (/ height 2)) (/ (min width height) pi) (color-r *text-color*) (color-g *text-color*) (color-b *text-color*)(color-a *text-color*) :smoothp t))
--- /project/pal/cvsroot/pal-gui/widgets.lisp 2007/10/30 00:20:41 1.13
+++ /project/pal/cvsroot/pal-gui/widgets.lisp 2007/10/30 20:44:46 1.14
@@ -1,35 +1,35 @@
(in-package :pal-gui)
+;; (declaim (optimize (speed 3)))
-(defparameter *window-color* '(140 140 140 160))
-(defparameter *widget-color* '(180 180 180 128))
-(defparameter *text-color* '(0 0 0 255))
-(defparameter *paper-color* '(255 255 200 255))
-(defparameter *tooltip-delay* 1)
+
+(defparameter *window-color* nil)
+(defparameter *widget-color* nil)
+(defparameter *text-color* nil)
+(defparameter *paper-color* nil)
+(defparameter *tooltip-delay* nil)
(defparameter *widget-enter-time* nil)
+(defparameter *m* nil)
+(defparameter *text-offset* nil)
(defvar *gui-font* nil)
-(defun get-m ()
- (truncate (* (get-font-height *gui-font*) 1.5)))
+
(defun get-text-bounds (string)
(let ((fh (get-font-height *gui-font*)))
(values (max (truncate (* 1.5 fh)) (+ (get-text-size string *gui-font*) fh))
(truncate (* fh 1.5)))))
-(defun get-text-offset ()
- (let ((fh (get-font-height *gui-font*)))
- (v (truncate fh 2) (truncate fh 4))))
(defun draw-frame (pos width height color &key style (border 1) (fill t))
(let ((pos (v-floor pos))
(width (truncate width))
(height (truncate height))
- (r (first color))
- (g (second color))
- (b (third color))
- (a (fourth color)))
+ (r (color-r color))
+ (g (color-g color))
+ (b (color-b color))
+ (a (color-a color)))
(when (> border 0)
(draw-rectangle (v- pos (v border border)) (+ width (* 2 border) ) (+ height (* 2 border)) 0 0 0 a))
(when fill
@@ -48,6 +48,7 @@
+(defgeneric present (object gob width height))
@@ -62,10 +63,10 @@
(on-key-down :accessor on-key-down-of :initarg :on-key-down :initform (lambda (widget char) (declare (ignore widget char)) nil))
(on-enter :accessor on-enter-of :initarg :on-enter :initform (lambda (widget) (declare (ignore widget)) nil))
(on-leave :accessor on-leave-of :initarg :on-leave :initform (lambda (widget) (declare (ignore widget)) nil)))
- (:default-initargs :width (get-m) :height (get-m)))
+ (:default-initargs :width *m* :height *m*))
-(defmethod on-inspect ((g widget))
+(defmethod on-inspect ((g gob))
(message g))
(defmethod on-drag :around ((g widget) pos d)
@@ -120,39 +121,38 @@
(defmethod repaint ((g box))
(when (label-of g)
- (let ((text-offset (get-text-offset)))
- (with-accessors ((width width-of) (height height-of) (label label-of)) g
+ (with-accessors ((width width-of) (height height-of) (label label-of)) g
- (draw-line (v 0 0) (v 0 height) 0 0 0 160)
- (draw-line (v width 0) (v width height) 0 0 0 160)
- (draw-line (v 0 height) (v width height) 0 0 0 160)
+ (draw-line (v 0 0) (v 0 height) 0 0 0 160)
+ (draw-line (v width 0) (v width height) 0 0 0 160)
+ (draw-line (v 0 height) (v width height) 0 0 0 160)
- (draw-line (v 0 0) (v (vx text-offset) 0) 0 0 0 160)
- (draw-line (v (- (get-text-bounds label) (vx text-offset)) 0) (v width 0) 0 0 0 160)
+ (draw-line (v 0 0) (v (vx *text-offset*) 0) 0 0 0 160)
+ (draw-line (v (- (get-text-bounds label) (vx *text-offset*)) 0) (v width 0) 0 0 0 160)
- (with-blend (:color *text-color*)
- (draw-text label (v- text-offset (v 0 (truncate (get-m) 2))) *gui-font*))))))
+ (with-blend (:color *text-color*)
+ (draw-text label (v- *text-offset* (v 0 (truncate *m* 2))) *gui-font*)))))
(defclass v-box (box v-packing)
()
- (:default-initargs :x-pad 0 :y-pad 0 :gap (truncate (get-m) 3)))
+ (:default-initargs :x-pad 0 :y-pad 0 :gap (truncate *m* 3)))
(defmethod initialize-instance :after ((g v-box) &key label)
(when label
- (setf (y-pad-of g) (truncate (get-m) 2)
- (x-pad-of g) (truncate (get-m) 2))))
+ (setf (y-pad-of g) (truncate *m* 2)
+ (x-pad-of g) (truncate *m* 2))))
(defclass h-box (box h-packing)
()
- (:default-initargs :x-pad 0 :y-pad 0 :gap (truncate (get-m) 2)))
+ (:default-initargs :x-pad 0 :y-pad 0 :gap (truncate *m* 2)))
(defmethod initialize-instance :after ((g h-box) &key label)
(when label
- (setf (y-pad-of g) (truncate (get-m) 2)
- (x-pad-of g) (truncate (get-m) 2))))
+ (setf (y-pad-of g) (truncate *m* 2)
+ (x-pad-of g) (truncate *m* 2))))
@@ -169,29 +169,29 @@
(defclass window (v-box sliding clipping)
((filler :accessor filler-of)
(label :accessor label-of :initarg :label :initform "Untitled"))
- (:default-initargs :activep t :width 100 :height 100 :x-pad (truncate (get-m) 2) :y-pad (truncate (get-m) 3) :gap (truncate (get-m) 3) :pos (v 10 10)))
+ (:default-initargs :activep t :width 100 :height 100 :x-pad (truncate *m* 2) :y-pad (truncate *m* 3) :gap (truncate *m* 3) :pos (v 10 10)))
(defmethod initialize-instance :after ((g window) &key &allow-other-keys)
(setf (filler-of g) (make-instance 'filler :parent g :x-expand-p t)))
(defmethod on-drag :around ((g window) start d)
(declare (ignore d))
- (when (< (vy start) (get-m))
+ (when (< (vy start) *m*)
(call-next-method)))
(defmethod on-button-down ((g window) pos)
- (when (< (vy pos) (get-m))
+ (when (< (vy pos) *m*)
(raise g)))
(defmethod repaint ((g window))
(with-accessors ((width width-of) (height height-of) (label label-of)) g
(draw-frame (v 0 0) width height *window-color* :style :raised)
- (draw-rectangle (v 0 0) width (get-m) 0 0 0 128)
- (draw-line (v 0 (get-m)) (v width (get-m)) 0 0 0 160)
- (draw-line (v 0 (1+ (get-m))) (v width (1+ (get-m))) 0 0 0 64)
- (draw-line (v 0 (+ (get-m) 2)) (v width (+ (get-m) 2)) 0 0 0 32)
- (with-blend (:color '(255 255 255 255))
- (draw-text label (get-text-offset) *gui-font*))))
+ (draw-rectangle (v 0 0) width *m* 0 0 0 128)
+ (draw-line (v 0 *m*) (v width *m*) 0 0 0 160)
+ (draw-line (v 0 (1+ *m*)) (v width (1+ *m*)) 0 0 0 64)
+ (draw-line (v 0 (+ *m* 2)) (v width (+ *m* 2)) 0 0 0 32)
+ (with-blend (:color (color 255 255 255 255))
+ (draw-text label *text-offset* *gui-font*))))
@@ -213,16 +213,14 @@
(defclass pin (label sliding highlighted constrained)
- ((r :accessor r-of :initarg :r :initform 255)
- (g :accessor g-of :initarg :g :initform 255)
- (b :accessor b-of :initarg :b :initform 255)
- (a :accessor a-of :initarg :a :initform 255))
+ ((color :accessor color-of :initarg :color :initform *paper-color*))
(:default-initargs :activep t))
(defmethod repaint ((g pin))
- (draw-rectangle (v 0 0) (width-of g) (height-of g) (r-of g) (g-of g) (b-of g) (a-of g))
- (call-next-method)
- (draw-rectangle (v 0 0) (width-of g) (height-of g) 0 0 0 (a-of g) :fill nil))
+ (let ((c (color-of g)))
+ (draw-rectangle (v 0 0) (width-of g) (height-of g) (color-r c) (color-g c) (color-b c) (color-a c))
+ (call-next-method)
+ (draw-rectangle (v 0 0) (width-of g) (height-of g) 0 0 0 (color-a c) :fill nil)))
@@ -273,15 +271,14 @@
(with-accessors ((width width-of) (height height-of) (value value-of) (min-value min-value-of) (max-value max-value-of)) g
(let* ((vt (princ-to-string value))
(sw (get-text-bounds vt))
- (m (get-m))
(k (truncate (* (/ (width-of g) (abs (- min-value max-value))) (- value min-value))))
(kpos (v (- k (truncate sw 2)) 0)))
- (draw-frame (v 0 (truncate m 3)) width (truncate height 2) *window-color* :style :sunken)
- (draw-frame kpos sw m *widget-color* :style :raised)
- (draw-frame (v+ kpos (v (truncate sw 2) 0)) 3 (/ m 4) '(0 0 0 0) :style :sunken :fill nil)
- (draw-frame (v+ kpos (v (truncate sw 2) m)) 3 (- (/ m 4)) '(0 0 0 0) :style :sunken :fill nil)
+ (draw-frame (v 0 (truncate *m* 3)) width (truncate height 2) *window-color* :style :sunken)
+ (draw-frame kpos sw *m* *widget-color* :style :raised)
+ (draw-frame (v+ kpos (v (truncate sw 2) 0)) 3 (/ *m* 4) (color 0 0 0 0) :style :sunken :fill nil)
+ (draw-frame (v+ kpos (v (truncate sw 2) *m*)) 3 (- (/ *m* 4)) (color 0 0 0 0) :style :sunken :fill nil)
(with-blend (:color *text-color*)
- (draw-text vt (v+ kpos (get-text-offset)) *gui-font*)))))
+ (draw-text vt (v+ kpos *text-offset*) *gui-font*)))))
@@ -315,7 +312,7 @@
*widget-color* :style :raised)
(draw-frame (v+ kpos (v 1 (1- (truncate (min height (- height (* (- units ps) usize))) 2))))
(- width 2)
- 3 '(255 255 255 0) :style :sunken))))
+ 3 (color 255 255 255 0) :style :sunken))))
@@ -337,19 +334,19 @@
(with-accessors ((width width-of) (height height-of) (min-value min-value-of) (max-value max-value-of) (value value-of)) g
(let* ( (k (truncate (* (/ width (abs (- min-value max-value))) (- value min-value)))) )
(draw-frame (v 0 0) width height *window-color* :style :sunken)
- (loop for x from 1 to (- k 3) by 2 do
+ (loop for x from 1 to (- k 3) by 3 do
(draw-line (v x 1) (v x (1- height)) 148 148 148 255))
(with-blend (:color *widget-color*)
- (draw-text (princ-to-string value) (v+ (v 1 1) (get-text-offset)) *gui-font*))
+ (draw-text (princ-to-string value) (v+ (v 1 1) *text-offset*) *gui-font*))
(with-blend (:color *text-color*)
- (draw-text (princ-to-string value) (get-text-offset) *gui-font*)))))
+ (draw-text (princ-to-string value) *text-offset* *gui-font*)))))
(defclass list-view (widget)
- ((items :accessor items-of :initarg :items :initform '())
- (item-height :reader item-height-of :initarg :item-height :initform (get-m))
+ ((items :accessor items-of :initarg :items :initform nil)
+ (item-height :reader item-height-of :initarg :item-height :initform *m*)
(multip :reader multip :initarg :multip :initform nil)
(selected :accessor selected-of :initform nil)
(scroll :reader scroll-of :initform 0))
@@ -405,8 +402,8 @@
(slider :accessor slider-of))
(:default-initargs :gap 3))
-(defmethod initialize-instance :after ((g list-widget) &key items (item-height (get-m)) (multip nil) &allow-other-keys)
- (let* ((w (truncate (get-m) 1.5))
+(defmethod initialize-instance :after ((g list-widget) &key items (item-height *m*) (multip nil) &allow-other-keys)
+ (let* ((w (truncate *m* 1.5))
(list-view (make-instance 'list-view
:multip multip
:items items
@@ -471,23 +468,23 @@
(defmethod repaint ((g radio-item))
(with-accessors ((height height-of) (width width-of) (value value-of)) g
- (let* ((m/2 (truncate (get-m) 2))
+ (let* ((m/2 (truncate *m* 2))
(m/4 (truncate m/2 2))
(ypos (truncate height 2)))
(draw-circle (v m/4 ypos)
(1+ (truncate m/2 2))
0 0 0 255
- :smoothp t)
+ :smoothp t :segments 10)
(draw-circle (v m/4 ypos)
(truncate m/2 2)
- (first *paper-color*) (second *paper-color*) (third *paper-color*) (fourth *paper-color*)
- :smoothp t)
+ (color-r *paper-color*) (color-g *paper-color*) (color-b *paper-color*) (color-a *paper-color*)
+ :smoothp t :segments 10)
(when (state-of g)
(draw-circle (v m/4 ypos) (- (truncate m/2 2) 2)
0 0 0 255
- :smoothp t))
- (with-transformation (:pos (v (truncate (get-m) 1.5) 0))
- (present value g (- width (get-m)) height)))))
+ :smoothp t :segments 10))
+ (with-transformation (:pos (v (truncate *m* 1.5) 0))
+ (present value g (- width *m*) height)))))
(defclass choice-item (button)
@@ -495,7 +492,7 @@
(defmethod repaint ((g choice-item))
(with-accessors ((height height-of) (width width-of) (value value-of)) g
- (let* ((m/2 (truncate (get-m) 2))
+ (let* ((m/2 (truncate *m* 2))
(ypos (- (truncate height 2) (truncate m/2 2))))
(draw-frame (v 0 ypos)
m/2 m/2
@@ -506,17 +503,17 @@
(- m/2 1) (- m/2 1)
*widget-color*
:style :raised))
- (with-transformation (:pos (v (truncate (get-m) 1.5) 0))
- (present value g (- width (get-m)) height)))))
+ (with-transformation (:pos (v (truncate *m* 1.5) 0))
+ (present value g (- width *m*) height)))))
(defclass choice-widget (v-box)
((multip :accessor multip :initarg :multip :initform nil)
- (items :accessor items-of :initarg :items :initform '())))
+ (items :accessor items-of :initarg :items :initform nil)))
-(defmethod initialize-instance :after ((g choice-widget) &key items multip (item-height (get-m)) &allow-other-keys)
+(defmethod initialize-instance :after ((g choice-widget) &key items multip (item-height *m*) &allow-other-keys)
(setf (items-of g) (mapcar (lambda (i)
(make-instance (if multip 'choice-item 'radio-item)
:parent g
@@ -556,14 +553,13 @@
(defmethod repaint ((g text-widget))
(with-accessors ((width width-of) (height height-of) (text text-of) (point point-of)) g
(draw-frame (v 0 0) width height *widget-color* :fill nil :style :raised)
- (draw-rectangle (v 1 1) (1- width) (1- height) (first *paper-color*) (second *paper-color*) (third *paper-color*) (fourth *paper-color*))
- (let* ((offset (get-text-offset))
- (point-x (+ (vx offset) (get-text-size (subseq text 0 point)))))
+ (draw-rectangle (v 1 1) (1- width) (1- height) (color-r *paper-color*) (color-g *paper-color*) (color-b *paper-color*) (color-a *paper-color*))
+ (let ( (point-x (+ (vx *text-offset*) (get-text-size (subseq text 0 point)))))
(with-blend (:color *text-color*)
- (draw-text text offset *gui-font*)
+ (draw-text text *text-offset* *gui-font*)
(when (focusedp g)
- (draw-rectangle (v point-x (vy offset))
- 2 (- height (* 2 (vy offset)))
+ (draw-rectangle (v point-x (vy *text-offset*))
+ 2 (- height (* 2 (vy *text-offset*)))
0 0 0 255))))))
(defmethod on-key-down ((g text-widget) char)
@@ -576,7 +572,7 @@
(defclass tooltip (gob)
((host :accessor host-of :initarg :host)
(text :reader text-of :initarg :text :initform ""))
- (:default-initargs :activep nil :width 100 :height (get-m) :pos (get-mouse-pos)))
+ (:default-initargs :activep nil :width 100 :height *m* :pos (get-mouse-pos)))
(defmethod initialize-instance :after ((g tooltip) &key text &allow-other-keys)
(setf (width-of g) (get-text-bounds text))
@@ -586,7 +582,7 @@
(defmethod repaint ((g tooltip))
(unless (pointedp (host-of g))
(setf (parent-of g) nil))
- (draw-rectangle (v 0 0) (width-of g) (height-of g) (first *paper-color*) (second *paper-color*) (third *paper-color*) (fourth *paper-color*))
+ (draw-rectangle (v 0 0) (width-of g) (height-of g) (color-r *paper-color*) (color-g *paper-color*) (color-b *paper-color*) (color-a *paper-color*))
(draw-rectangle (v 0 0) (width-of g) (height-of g) 0 0 0 255 :fill nil)
(with-blend (:color *text-color*)
- (draw-text (text-of g) (get-text-offset) *gui-font*)))
\ No newline at end of file
+ (draw-text (text-of g) *text-offset* *gui-font*)))
\ No newline at end of file
More information about the Pal-cvs
mailing list