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

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

--- /project/cl-fltk/cvsroot/cl-fltk/src/package.lisp 2006/03/02 07:24:21 1.2 +++ /project/cl-fltk/cvsroot/cl-fltk/src/package.lisp 2006/03/09 10:02:55 1.3 @@ -4,13 +4,44 @@ (:use #:common-lisp) (:nicknames fl fltk) (:export - ProgressBar + +ALIGN-BOTTOM+ + +ALIGN-BOTTOMLEFT+ + +ALIGN-BOTTOMRIGHT+ + +ALIGN-CENTER+ + +ALIGN-CENTERLEFT+ + +ALIGN-CLIP+ + +ALIGN-INSIDE+ + +ALIGN-INSIDE-BOTTOM+ + +ALIGN-INSIDE-BOTTOMLEFT+ + +ALIGN-INSIDE-BOTTOMRIGHT+ + +ALIGN-INSIDE-LEFT+ + +ALIGN-INSIDE-RIGHT+ + +ALIGN-INSIDE-TOP+ + +ALIGN-INSIDE-TOPLEFT+ + +ALIGN-INSIDE-TOPRIGHT+ + +ALIGN-LEFT+ + +ALIGN-LEFTBOTTOM+ + +ALIGN-LEFTTOP+ + +ALIGN-MASK+ + +ALIGN-RIGHT+ + +ALIGN-RIGHTBOTTOM+ + +ALIGN-RIGHTTOP+ + +ALIGN-TOP+ + +ALIGN-TOPLEFT+ + +ALIGN-TOPRIGHT+ + +ALIGN-WRAP+ + +BLACK+ + +BLUE+ +BORDER-BOX+ +BORDER-FRAME+ + +CHANGED+ + +CLICK-TO-FOCUS+ + +COPIED-LABEL+ +COURIER+ +COURIER-BOLD+ +COURIER-BOLD-ITALIC+ +COURIER-ITALIC+ + +CYAN+ +DIAMOND-DOWN-BOX+ +DIAMOND-UP-BOX+ +DOTTED-FRAME+ @@ -20,20 +51,57 @@ +ENGRAVED-BOX+ +ENGRAVED-LABEL+ +FLAT-BOX+ + +FOCUSED+ + +GRAY00+ + +GRAY05+ + +GRAY10+ + +GRAY15+ + +GRAY20+ + +GRAY25+ + +GRAY30+ + +GRAY33+ + +GRAY35+ + +GRAY40+ + +GRAY45+ + +GRAY50+ + +GRAY55+ + +GRAY60+ + +GRAY65+ + +GRAY66+ + +GRAY70+ + +GRAY75+ + +GRAY80+ + +GRAY85+ + +GRAY90+ + +GRAY95+ + +GRAY99+ + +GREEN+ +HELVETICA+ +HELVETICA-BOLD+ +HELVETICA-BOLD-ITALIC+ +HELVETICA-ITALIC+ + +HIGHLIGHT+ +HIGHLIGHT-DOWN-BOX+ +HIGHLIGHT-UP-BOX+ + +INACTIVE+ + +INVISIBLE+ + +LAYOUT-VERTICAL+ + +MAGENTA+ +NO-BOX+ + +NO-COLOR+ + +NO-FLAGS+ +NO-LABEL+ +NORMAL-LABEL+ + +NOTACTIVE+ +OFLAT-BOX+ +OSHADOW-BOX+ + +OUTPUT+ +OVAL-BOX+ +PLASTIC-DOWN-BOX+ +PLASTIC-UP-BOX+ + +PUSHED+ + +RAW-LABEL+ + +RED+ +RFLAT-BOX+ +ROUND-DOWN-BOX+ +ROUND-UP-BOX+ @@ -41,10 +109,12 @@ +RSHADOW-BOX+ +SCREEN-BOLD-FONT+ +SCREEN-FONT+ + +SELECTED+ +SHADOW-BOX+ +SHADOW-LABEL+ +SYMBOL-FONT+ +SYMBOL-LABEL+ + +TAB-TO-FOCUS+ +THIN-DOWN-BOX+ +THIN-UP-BOX+ +TIMES+ @@ -52,119 +122,50 @@ +TIMES-BOLD-ITALIC+ +TIMES-ITALIC+ +UP-BOX+ + +VALUE+ + +WHITE+ + +WINDOWS-BLUE+ + +YELLOW+ +ZAPF-DINGBATS+ + ProgressBar + add-timeout ask begin box + buttonbox + buttoncolor callback + clear-flag + color end + focusbox foreign-object hide + highlight-color + highlight-textcolor + labelcolor labelfont labelsize labeltype + leading new-button + new-progressbar new-widget new-window - show - new-progressbar - progressbar-step - +NO-FLAGS+ - +ALIGN-CENTER+ - +ALIGN-TOP+ - +ALIGN-BOTTOM+ - +ALIGN-LEFTTOP+ - +ALIGN-LEFT+ - +ALIGN-TOPLEFT+ - +ALIGN-BOTTOMLEFT+ - +ALIGN-LEFTBOTTOM+ - +ALIGN-RIGHT+ - +ALIGN-TOPRIGHT+ - +ALIGN-BOTTOMRIGHT+ - +ALIGN-RIGHTTOP+ - +ALIGN-CENTERLEFT+ - +ALIGN-RIGHTBOTTOM+ - +ALIGN-INSIDE+ - +ALIGN-INSIDE-TOP+ - +ALIGN-INSIDE-BOTTOM+ - +ALIGN-INSIDE-LEFT+ - +ALIGN-INSIDE-TOPLEFT+ - +ALIGN-INSIDE-BOTTOMLEFT+ - +ALIGN-INSIDE-RIGHT+ - +ALIGN-INSIDE-TOPRIGHT+ - +ALIGN-INSIDE-BOTTOMRIGHT+ - +ALIGN-CLIP+ - +ALIGN-WRAP+ - +ALIGN-MASK+ - +NOTACTIVE+ - +OUTPUT+ - +VALUE+ - +SELECTED+ - +INVISIBLE+ - +HIGHLIGHT+ - +CHANGED+ - +COPIED-LABEL+ - +RAW-LABEL+ - +LAYOUT-VERTICAL+ - +TAB-TO-FOCUS+ - +CLICK-TO-FOCUS+ - +INACTIVE+ - +FOCUSED+ - +PUSHED+ - +NO-COLOR+ - +GRAY00+ - +GRAY05+ - +GRAY10+ - +GRAY15+ - +GRAY20+ - +GRAY25+ - +GRAY30+ - +GRAY33+ - +GRAY35+ - +GRAY40+ - +GRAY45+ - +GRAY50+ - +GRAY55+ - +GRAY60+ - +GRAY65+ - +GRAY66+ - +GRAY70+ - +GRAY75+ - +GRAY80+ - +GRAY85+ - +GRAY90+ - +GRAY95+ - +GRAY99+ - +BLACK+ - +RED+ - +GREEN+ - +YELLOW+ - +BLUE+ - +MAGENTA+ - +CYAN+ - +WHITE+ - +WINDOWS-BLUE+ - progressbar-position - add-timeout - clear-flag - set-flag - selection-color - color - textcolor - progresbar-minimum progresbar-maximum + progresbar-minimum + progressbar-position progressbar-showtext + progressbar-step progressbar-text-color - buttonbox - focusbox - textfont - selection-textcolor - buttoncolor - labelcolor - highlight-color - highlight-textcolor - textsize - leading scrollbar-align scrollbar-width + selection-color + selection-textcolor + send + set-flag + show + textcolor + textfont + textsize )) --- /project/cl-fltk/cvsroot/cl-fltk/src/widget.lisp 2006/03/02 07:24:21 1.2 +++ /project/cl-fltk/cvsroot/cl-fltk/src/widget.lisp 2006/03/09 10:02:55 1.3 @@ -27,8 +27,6 @@ (defun hide (widget) (cffi:foreign-funcall "fl_widget_hide" :pointer (cl-fltk:foreign-object widget))) - -(defgeneric callback (widget function &optional data))

;;TODO :pointer data -> :string data -> :int data etc. (defmethod callback ((widget Widget) (callback-function symbol) &optional (data (cffi:null-pointer))) @@ -37,33 +35,28 @@ :pointer (cffi:get-callback callback-function) :pointer data))

-(defgeneric box (widget string)) - (defmethod box ((widget widget) box) (cffi:foreign-funcall "fl_widget_box" :pointer (cl-fltk:foreign-object widget) :pointer box))

-(defgeneric labelfont (widget font)) - (defmethod labelfont ((widget Widget) font) (cffi:foreign-funcall "fl_widget_labelfont" :pointer (cl-fltk:foreign-object widget) :pointer font))

-(defgeneric labeltype (widget type)) - (defmethod labeltype ((widget Widget) type) (cffi:foreign-funcall "fl_widget_labeltype" :pointer (cl-fltk:foreign-object widget) :pointer type))

-(defgeneric labelsize (widget size)) - -(defmethod labelsize ((widget Widget) (size float)) - (cffi:foreign-funcall "fl_widget_labelsize" - :pointer (cl-fltk:foreign-object widget) - :float size)) +(defmethod labelsize ((widget Widget) &optional size) + (if size + (cffi:foreign-funcall "fl_widget_labelsize" + :pointer (cl-fltk:foreign-object widget) + :float size) + (cffi:foreign-funcall "fl_widget_get_labelsize" + :pointer (cl-fltk:foreign-object widget) :float)))

(defmethod clear-flag ((widget Widget) (flag integer)) (cffi:foreign-funcall "fl_widget_clear_flag" @@ -75,20 +68,29 @@ :pointer (cl-fltk:foreign-object widget) :int flag))

-(defmethod selection-color ((widget Widget) (color integer)) - (cffi:foreign-funcall "fl_widget_selection_color" - :pointer (cl-fltk:foreign-object widget) - :int color)) - -(defmethod color ((widget Widget) (color integer)) - (cffi:foreign-funcall "fl_widget_color" - :pointer (cl-fltk:foreign-object widget) - :int color)) - -(defmethod textcolor ((widget Widget) (color integer)) - (cffi:foreign-funcall "fl_widget_textcolor" - :pointer (cl-fltk:foreign-object widget) - :int color)) +(defmethod selection-color ((widget Widget) &optional color) + (if color + (cffi:foreign-funcall "fl_widget_selection_color" + :pointer (cl-fltk:foreign-object widget) + :int color) + (cffi:foreign-funcall "fl_widget_get_selection_color" + :pointer (cl-fltk:foreign-object widget) :int ))) + +(defmethod color ((widget Widget) &optional color) + (if color + (cffi:foreign-funcall "fl_widget_color" + :pointer (cl-fltk:foreign-object widget) + :int color) + (cffi:foreign-funcall "fl_widget_get_color" + :pointer (cl-fltk:foreign-object widget) :int))) + +(defmethod textcolor ((widget Widget) color) + (if color + (cffi:foreign-funcall "fl_widget_textcolor" + :pointer (cl-fltk:foreign-object widget) + :int color) + (cffi:foreign-funcall "fl_widget_get_textcolor" + :pointer (cl-fltk:foreign-object widget) :int)))

(defmethod buttonbox ((widget Widget) box) (cffi:foreign-funcall "fl_widget_buttonbox" @@ -105,47 +107,79 @@ :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 selection-textcolor ((widget Widget) &optional color) + (if color + (cffi:foreign-funcall "fl_widget_selection_textcolor" + :pointer (cl-fltk:foreign-object widget) + :int color) + (cffi:foreign-funcall "fl_widget_get_selection_textcolor" + :pointer (cl-fltk:foreign-object widget) :int))) + +(defmethod buttoncolor ((widget Widget) &optional color) + (if color + (cffi:foreign-funcall "fl_widget_buttoncolor" + :pointer (cl-fltk:foreign-object widget) + :int color) + (cffi:foreign-funcall "fl_widget_get_buttoncolor" + :pointer (cl-fltk:foreign-object widget) :int))) + +(defmethod labelcolor ((widget Widget) &optional color) + (if color + (cffi:foreign-funcall "fl_widget_labelcolor" + :pointer (cl-fltk:foreign-object widget) + :int color) + (cffi:foreign-funcall "fl_widget_get_labelcolor" + :pointer (cl-fltk:foreign-object widget) :int))) + +(defmethod highlight-color ((widget Widget) &optional color) + (if color + (cffi:foreign-funcall "fl_widget_highlight_color" + :pointer (cl-fltk:foreign-object widget) + :int color) + (cffi:foreign-funcall "fl_widget_get_highlight_color" + :pointer (cl-fltk:foreign-object widget) :int))) + +(defmethod highlight-textcolor ((widget Widget) &optional color) + (if color + (cffi:foreign-funcall "fl_widget_highlight_textcolor" + :pointer (cl-fltk:foreign-object widget) + :int color) + (cffi:foreign-funcall "fl_widget_get_highlight_textcolor" + :pointer (cl-fltk:foreign-object widget) :int))) + +(defmethod textsize ((widget Widget) &optional size) + (if size + (cffi:foreign-funcall "fl_widget_textsize" + :pointer (cl-fltk:foreign-object widget) + :float size) + (cffi:foreign-funcall "fl_widget_get_textsize" + :pointer (cl-fltk:foreign-object widget) :float))) + +(defmethod leading ((widget Widget) &optional leading) + (if leading + (cffi:foreign-funcall "fl_widget_leading" + :pointer (cl-fltk:foreign-object widget) + :float leading) + (cffi:foreign-funcall "fl_widget_get_leading" + :pointer (cl-fltk:foreign-object widget) :float))) + +(defmethod scrollbar-align ((widget Widget) &optional c) + (if c + (cffi:foreign-funcall "fl_widget_scrollbar_align" + :pointer (cl-fltk:foreign-object widget) + :unsigned-char c) + (cffi:foreign-funcall "fl_widget_get_scrollbar_align" + :pointer (cl-fltk:foreign-object widget) :unsigned-char))) + +(defmethod scrollbar-width ((widget Widget) &optional c) + (if c + (cffi:foreign-funcall "fl_widget_scrollbar_width" + :pointer (cl-fltk:foreign-object widget) + :unsigned-char c) + (cffi:foreign-funcall "fl_widget_get_scrollbar_width" + :pointer (cl-fltk:foreign-object widget) :unsigned-char)))

-(defmethod scrollbar-width ((widget Widget) c) - (cffi:foreign-funcall "fl_widget_scrollbar_width" +(defmethod send ((widget Widget) event) + (cffi:foreign-funcall "fl_widget_send" :pointer (cl-fltk:foreign-object widget) - :unsigned-char c)) + :int event :int))