[Cl-fltk-cvs] CVS cl-fltk/src
dlah
dlah at common-lisp.net
Thu Mar 9 10:02:55 UTC 2006
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))
More information about the Cl-fltk-cvs
mailing list