[Cl-fltk-cvs] CVS cl-fltk/src

[dlah]

Update of /project/cl-fltk/cvsroot/cl-fltk/src
In directory clnet:/tmp/cvs-serv17150/src

Modified Files:
	package.lisp progressbar.lisp widget.lisp 
Log Message:


--- /project/cl-fltk/cvsroot/cl-fltk/src/package.lisp	2006/02/27 08:26:41	1.1
+++ /project/cl-fltk/cvsroot/cl-fltk/src/package.lisp	2006/03/02 07:24:21	1.2
@@ -151,4 +151,20 @@
    selection-color
    color
    textcolor
+   progresbar-minimum
+   progresbar-maximum
+   progressbar-showtext
+   progressbar-text-color
+   buttonbox
+   focusbox
+   textfont
+   selection-textcolor
+   buttoncolor
+   labelcolor
+   highlight-color
+   highlight-textcolor
+   textsize
+   leading
+   scrollbar-align
+   scrollbar-width
    ))
--- /project/cl-fltk/cvsroot/cl-fltk/src/progressbar.lisp	2006/02/27 08:26:41	1.1
+++ /project/cl-fltk/cvsroot/cl-fltk/src/progressbar.lisp	2006/03/02 07:24:21	1.2
@@ -22,13 +22,14 @@
 			:double max
 			:double step))
 ;;step is allready used as function name so here is renamed to preogressbar-step
-(defmethod progressbar-step ((pb ProgressBar) (step double-float))
-  (cffi:foreign-funcall "fl_progressbar_step"
-			:pointer (cl-fltk:foreign-object pb)
-			:double step))
+(defmethod progressbar-step ((pb ProgressBar) &optional step)
+  (if step
+      (cffi:foreign-funcall "fl_progressbar_step"
+			    :pointer (cl-fltk:foreign-object pb)
+			    :double step)
+      (cffi:foreign-funcall "fl_progressbar_get_step"
+			    :pointer (cl-fltk:foreign-object pb))))
 
-  ;void fl_progressbar_position(ProgressBar* pb, double pos);
-;  double fl_progressbar_get_position(ProgressBar* pb);
 (defmethod progressbar-position ((pb ProgressBar) &optional position)
   (if position
       (cffi:foreign-funcall "fl_progressbar_position"
@@ -37,14 +38,34 @@
       (cffi:foreign-funcall "fl_progressbar_get_position"
 			    :pointer (cl-fltk:foreign-object pb) :double))
 
+(defmethod progressbar-minimum ((pb ProgressBar) &optional nm)
+  (if nm
+      (cffi:foreign-funcall "fl_progressbar_minimum"
+			    :pointer (cl-fltk:foreign-object pb)
+			    :double nm))
+      (cffi:foreign-funcall "fl_progressbar_get_minimum"
+			    :pointer (cl-fltk:foreign-object pb) :double))
+
+(defmethod progressbar-maximum ((pb ProgressBar) &optional nm)
+  (if nm
+      (cffi:foreign-funcall "fl_progressbar_maximum"
+			    :pointer (cl-fltk:foreign-object pb)
+			    :double nm))
+      (cffi:foreign-funcall "fl_progressbar_get_maximum"
+			    :pointer (cl-fltk:foreign-object pb) :double))
 
-;;TODO
-  ;double fl_progressbar_get_minimum(ProgressBar* pb);
-;  double fl_progressbar_get_maximum(ProgressBar* pb);
- ; void fl_progressbar_minimum(ProgressBar* pb, double nm);
-  ;void fl_progressbar_maximum(ProgressBar* pb, double nm);
- ; double fl_progressbar_get_step(ProgressBar* pb);
-;  void fl_progressbar_showtext(ProgressBar* pb, bool st);
- ; bool fl_progressbar_get_showtext(ProgressBar* pb);
-  ;void fl_progressbar_text_color(ProgressBar* pb, Color col);
-;  Color fl_progressbar_get_text_color(ProgressBar* pb);
+(defmethod progressbar-showtext ((pb ProgressBar) &optional flag)
+  (if flag
+      (cffi:foreign-funcall "fl_progressbar_showtext"
+			    :pointer (cl-fltk:foreign-object pb)
+			    :boolean flag))
+      (cffi:foreign-funcall "fl_progressbar_get_showtext"
+			    :pointer (cl-fltk:foreign-object pb) :boolean))
+
+(defmethod progressbar-text-color ((pb ProgressBar) &optional color)
+  (if color
+      (cffi:foreign-funcall "fl_progressbar_text_color"
+			    :pointer (cl-fltk:foreign-object pb)
+			    :int color))
+      (cffi:foreign-funcall "fl_progressbar_get_text_color"
+			    :pointer (cl-fltk:foreign-object pb) :int))
--- /project/cl-fltk/cvsroot/cl-fltk/src/widget.lisp	2006/02/27 08:26:41	1.1
+++ /project/cl-fltk/cvsroot/cl-fltk/src/widget.lisp	2006/03/02 07:24:21	1.2
@@ -3,6 +3,10 @@
 (defclass Widget (cl-fltk-object)
   ())
 
+(defconstant +RESERVED-TYPE+ #x64)
+(defconstant +GROUP-TYPE+ #xE0)
+(defconstant +WINDOW-TYPE+ #xF0)
+
 (defun new-widget (x y width height text)
   (let ((widget-instance (make-instance 'Widget )))
     (setf (foreign-object widget-instance)
@@ -35,24 +39,24 @@
 
 (defgeneric box (widget string))
 
-(defmethod box ((widget widget) box) ;specialize box param to MACPTR,SAP whatever, CL specific
+(defmethod box ((widget widget) box)
   (cffi:foreign-funcall "fl_widget_box"
 			:pointer (cl-fltk:foreign-object widget)
 			:pointer box))
 
-(defgeneric labelfont (widget font));specialize type param to MACPTR,SAP whatever, CL specific
+(defgeneric labelfont (widget font))
 
 (defmethod labelfont ((widget Widget) font)
   (cffi:foreign-funcall "fl_widget_labelfont"
 			:pointer (cl-fltk:foreign-object widget)
-			:string font))
+			:pointer font))
 
 (defgeneric labeltype (widget type))
 
-(defmethod labeltype ((widget Widget) type);specialize type param to MACPTR,SAP whatever, CL specific
+(defmethod labeltype ((widget Widget) type)
   (cffi:foreign-funcall "fl_widget_labeltype"
 			:pointer (cl-fltk:foreign-object widget)
-			:string type))
+			:pointer type))
 
 (defgeneric labelsize (widget size))
 
@@ -85,3 +89,63 @@
   (cffi:foreign-funcall "fl_widget_textcolor"
 			:pointer (cl-fltk:foreign-object widget)
 			:int color))
+
+(defmethod buttonbox ((widget Widget) box)
+  (cffi:foreign-funcall "fl_widget_buttonbox"
+			:pointer (cl-fltk:foreign-object widget)
+			:pointer box))
+
+(defmethod focusbox ((widget Widget) box)
+  (cffi:foreign-funcall "fl_widget_focusbox"
+			:pointer (cl-fltk:foreign-object widget)
+			:pointer box))
+
+(defmethod textfont ((widget Widget) font)
+  (cffi:foreign-funcall "fl_widget_textfont"
+			:pointer (cl-fltk:foreign-object widget)
+			:pointer font))
+
+(defmethod selection-textcolor ((widget Widget) color)
+  (cffi:foreign-funcall "fl_widget_selection_textcolor"
+			:pointer (cl-fltk:foreign-object widget)
+			:int color))
+
+(defmethod buttoncolor ((widget Widget) color)
+  (cffi:foreign-funcall "fl_widget_buttoncolor"
+			:pointer (cl-fltk:foreign-object widget)
+			:int color))
+
+(defmethod labelcolor ((widget Widget) color)
+  (cffi:foreign-funcall "fl_widget_labelcolor"
+			:pointer (cl-fltk:foreign-object widget)
+			:int color))
+
+(defmethod highlight-color ((widget Widget) color)
+  (cffi:foreign-funcall "fl_widget_highlight_color"
+			:pointer (cl-fltk:foreign-object widget)
+			:int color))
+
+(defmethod highlight-textcolor ((widget Widget) color)
+  (cffi:foreign-funcall "fl_widget_highlight_textcolor"
+			:pointer (cl-fltk:foreign-object widget)
+			:int color))
+
+(defmethod textsize ((widget Widget) (size float))
+  (cffi:foreign-funcall "fl_widget_textsize"
+			:pointer (cl-fltk:foreign-object widget)
+			:float size))
+
+(defmethod leading ((widget Widget) (leading float))
+  (cffi:foreign-funcall "fl_widget_leading"
+			:pointer (cl-fltk:foreign-object widget)
+			:float leading))
+
+(defmethod scrollbar-align ((widget Widget) c)
+  (cffi:foreign-funcall "fl_widget_scrollbar_align"
+			:pointer (cl-fltk:foreign-object widget)
+			:unsigned-char c))
+
+(defmethod scrollbar-width ((widget Widget) c)
+  (cffi:foreign-funcall "fl_widget_scrollbar_width"
+			:pointer (cl-fltk:foreign-object widget)
+			:unsigned-char c))