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))