From dlah at common-lisp.net Thu Mar 2 07:24:21 2006 From: dlah at common-lisp.net (dlah) Date: Thu, 2 Mar 2006 02:24:21 -0500 (EST) Subject: [Cl-fltk-cvs] CVS cl-fltk/wrapper Message-ID: <20060302072421.CD4E173230@common-lisp.net> Update of /project/cl-fltk/cvsroot/cl-fltk/wrapper In directory clnet:/tmp/cvs-serv17150/wrapper Modified Files: widget.cc widget.h Log Message: --- /project/cl-fltk/cvsroot/cl-fltk/wrapper/widget.cc 2006/02/27 08:26:41 1.1 +++ /project/cl-fltk/cvsroot/cl-fltk/wrapper/widget.cc 2006/03/02 07:24:21 1.2 @@ -77,3 +77,76 @@ debug("%s:%s %x %i\n", __FILE__, __FUNCTION__, (unsigned int)widget, c); return widget->selection_color(c); } + +void fl_widget_buttonbox(Widget* widget, Box* box) +{ + debug("%s:%s %x %x\n", __FILE__, __FUNCTION__, (unsigned int)widget, (unsigned int)box); + return widget->buttonbox(box); +} + +void fl_widget_focusbox(Widget* widget, Box* box) +{ + debug("%s:%s %x %x\n", __FILE__, __FUNCTION__, (unsigned int)widget, (unsigned int)box); + return widget->focusbox(box); +} + +void fl_widget_textfont(Widget* widget, Font* font) +{ + debug("%s:%s %x %x\n", __FILE__, __FUNCTION__, (unsigned int)widget, (unsigned int)font); + return widget->textfont(font); +} + +void fl_widget_selection_textcolor(Widget* widget, Color color) +{ + debug("%s:%s %x %i\n", __FILE__, __FUNCTION__, (unsigned int)widget, color); + return widget->textcolor(color); +} + +void fl_widget_buttoncolor(Widget* widget, Color color) +{ + debug("%s:%s %x %i\n", __FILE__, __FUNCTION__, (unsigned int)widget, color); + return widget->buttoncolor(color); +} + +void fl_widget_labelcolor(Widget* widget, Color color) +{ + debug("%s:%s %x %i\n", __FILE__, __FUNCTION__, (unsigned int)widget, color); + return widget->labelcolor(color); +} + +void fl_widget_highlight_color(Widget* widget, Color color) +{ + debug("%s:%s %x %i\n", __FILE__, __FUNCTION__, (unsigned int)widget, color); + return widget->highlight_color(color); +} + +void fl_widget_highlight_textcolor(Widget* widget, Color color) +{ + debug("%s:%s %x %i\n", __FILE__, __FUNCTION__, (unsigned int)widget, color); + return widget->highlight_textcolor(color); +} + +void fl_widget_textsize(Widget* widget, float a) +{ + debug("%s:%s %x %f\n", __FILE__, __FUNCTION__, (unsigned int)widget, a); + return widget->textsize(a); +} + +void fl_widget_leading(Widget* widget, float a) +{ + debug("%s:%s %x %f\n", __FILE__, __FUNCTION__, (unsigned int)widget, a); + return widget->leading(a); +} + +void fl_widget_scrollbar_align(Widget* widget, unsigned char c) +{ + debug("%s:%s %x %c\n", __FILE__, __FUNCTION__, (unsigned int)widget, c); + return widget->scrollbar_align(c); + +} + +void fl_widget_scrollbar_width(Widget* widget, unsigned char c) +{ + debug("%s:%s %x %c\n", __FILE__, __FUNCTION__, (unsigned int)widget, c); + return widget->scrollbar_width(c); +} --- /project/cl-fltk/cvsroot/cl-fltk/wrapper/widget.h 2006/02/27 08:26:41 1.1 +++ /project/cl-fltk/cvsroot/cl-fltk/wrapper/widget.h 2006/03/02 07:24:21 1.2 @@ -23,5 +23,181 @@ void fl_widget_color(Widget *widget, int c); void fl_widget_textcolor(Widget * widget, int c); void fl_widget_selection_color(Widget *widget, int c); + void fl_widget_buttonbox(Widget* widget, Box*); + void fl_widget_focusbox(Widget* widget, Box*); + void fl_widget_textfont(Widget* widget, Font*); + void fl_widget_selection_textcolor(Widget* widget, Color); + void fl_widget_buttoncolor(Widget* widget, Color); + void fl_widget_labelcolor(Widget* widget, Color); + void fl_widget_highlight_color(Widget* widget, Color); + void fl_widget_highlight_textcolor(Widget* widget, Color); + void fl_widget_textsize(Widget* widget, float a); + void fl_widget_leading(Widget* widget, float a); + void fl_widget_scrollbar_align(Widget* widget, unsigned char); + void fl_widget_scrollbar_width(Widget* widget, unsigned char); + /* + Color color() const; + Color textcolor() const; + Color selection_color() const; + Color selection_textcolor() const; + Color buttoncolor() const; + Color labelcolor() const; + Color highlight_color() const; + Color highlight_textcolor() const; + float labelsize() const; + float textsize() const; + float leading() const; + unsigned char scrollbar_align() const; + unsigned char scrollbar_width() const; + */ + /* + int send(int event); + + const Style* style() const { return style_; } + void style(const Style* s) { style_ = s; } + void style(const Style& s) { style_ = &s; } + bool copy_style(const Style* s); + static NamedStyle* default_style; + static Symbol* default_glyph; + + Group* parent() const { return parent_; } + void parent(Group* w) { parent_ = w; } + Window* window() const ; + + uchar type() const { return type_; } + void type(uchar t) { type_ = t; } + bool is_group() const { return type_ >= GROUP_TYPE; } + bool is_window() const { return type_ >= WINDOW_TYPE; } + + bool resize(int x,int y,int w,int h); + bool position(int x, int y) ; + bool resize(int w, int h) ; +void get_absolute_rect( Rectangle *rect ) const; + + const char* label() const { return label_; } + void label(const char* a); + void copy_label(const char* a); + + const Symbol* image() const { return image_; } + void image(const Symbol* a) { image_ = a; } + void image(const Symbol& a) { image_ = &a; } + + const char *tooltip() const { return tooltip_; } + void tooltip(const char *t) { tooltip_ = t; } + + unsigned shortcut() const ; + bool shortcut(unsigned key) ; + bool add_shortcut(unsigned key); + bool remove_shortcut(unsigned key); + bool remove_shortcuts() ; + unsigned label_shortcut() const; + bool test_label_shortcut() const; + bool test_shortcut() const ; + bool test_shortcut(bool) const; + + Callback_p callback() const { return callback_; } + void callback(Callback* c, void* p) { callback_=c; user_data_=p; } + void callback(Callback* c) { callback_=c; } + void callback(Callback0*c) { callback_=(Callback*)c; } + void callback(Callback1*c, long p=0) { callback_=(Callback*)c; user_data_=(void*)p; } + void* user_data() const { return user_data_; } + void user_data(void* v) { user_data_ = v; } + long argument() const { return (long)user_data_; } + void argument(long v) { user_data_ = (void*)v; } + uchar when() const { return when_; } + void when(uchar i) { when_ = i; } + + static void default_callback(Widget*, void*); + void do_callback() { callback_(this,user_data_); } + void do_callback(Widget* o,void* arg=0) { callback_(o,arg); } + void do_callback(Widget* o,long arg) { callback_(o,(void*)arg); } + bool contains(const Widget*) const; + bool inside(const Widget* o) const { return o && o->contains(this); } + bool pushed() const ; + bool focused() const ; + bool belowmouse() const ; + + Flags flags() const { return flags_; } + Flags flags(Flags f) { return flags_ = f; } + Flags set_flag(int c) { return flags_ |= c; } + Flags clear_flag(int c) { return flags_ &= ~c; } + Flags invert_flag(int c) { return flags_ ^= c; } + + Flags align() const { return flags_&ALIGN_MASK; } + void align(unsigned a) { flags_ = (flags_ & (~ALIGN_MASK)) | a; } + bool visible() const { return !(flags_&INVISIBLE); } + bool visible_r() const ; + void show() ; + void hide() ; + void set_visible() { flags_ &= ~INVISIBLE; } + void clear_visible() { flags_ |= INVISIBLE; } + bool active() const { return !(flags_&NOTACTIVE); } + bool active_r() const ; + void activate() ; + void activate(int b) { if (b) activate(); else deactivate(); } + void deactivate() ; + bool output() const { return (flags_&OUTPUT)!=0; } + void set_output() { flags_ |= OUTPUT; } + void clear_output() { flags_ &= ~OUTPUT; } + bool takesevents() const { return !(flags_&(OUTPUT|INVISIBLE|NOTACTIVE)); } + bool changed() const { return (flags_&CHANGED)!=0; } + void set_changed() { flags_ |= CHANGED; } + void clear_changed() { flags_ &= ~CHANGED; } + bool value() const { return (flags_&VALUE)!=0; } + void set_value() { flags_ |= VALUE; } + void clear_value() { flags_ &= ~VALUE; } + bool selected() const { return (flags_&SELECTED)!=0; } + void set_selected() { flags_ |= SELECTED; } + void clear_selected() { flags_ &= ~SELECTED; } + bool click_to_focus() { return (flags_ & CLICK_TO_FOCUS) != 0; } + void set_click_to_focus() { flags_ |= CLICK_TO_FOCUS; } + void clear_click_to_focus() { flags_ &= ~CLICK_TO_FOCUS; } + bool tab_to_focus() { return (flags_ & TAB_TO_FOCUS) != 0; } + void set_tab_to_focus() { flags_ |= TAB_TO_FOCUS; } + void clear_tab_to_focus() { flags_ &= ~(TAB_TO_FOCUS|CLICK_TO_FOCUS); } + bool horizontal() const { return !(flags_&LAYOUT_VERTICAL);} + bool vertical() const { return (flags_&LAYOUT_VERTICAL)!=0;} + void set_horizontal() { flags_ &= ~LAYOUT_VERTICAL; } + void set_vertical() { flags_ |= LAYOUT_VERTICAL; } + bool take_focus() ; + void throw_focus() ; + + void redraw() ; + void redraw(uchar c) ; + void redraw_label() ; + void redraw_highlight() ; + void redraw(const Rectangle&); + uchar damage() const { return damage_; } + void set_damage(uchar c) { damage_ = c; } // should be called damage(c) + + void relayout() ; + void relayout(uchar damage) ; + uchar layout_damage() const { return layout_damage_; } + void layout_damage(uchar c) { layout_damage_ = c; } + + void add_timeout(float) ; + void repeat_timeout(float) ; + void remove_timeout() ; + + void make_current() const ; + void draw_background() const ; + void draw_frame() const ; + void draw_box() const ; + void draw_label() const ; + void draw_label(const Rectangle&, Flags) const ; + void draw_glyph(int, const Rectangle&) const ; + void cursor(Cursor*) const ; + void measure_label(int&, int&) const ; + Box* box() const; + Box* buttonbox() const; + Box* focusbox() const; + Symbol* glyph() const; + Font* labelfont() const; + Font* textfont() const; + LabelType* labeltype() const; + + void glyph(Symbol*) ; + */ + } #endif From dlah at common-lisp.net Thu Mar 2 07:24:21 2006 From: dlah at common-lisp.net (dlah) Date: Thu, 2 Mar 2006 02:24:21 -0500 (EST) Subject: [Cl-fltk-cvs] CVS cl-fltk/src Message-ID: <20060302072421.B555F7322F@common-lisp.net> 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)) From dlah at common-lisp.net Thu Mar 9 10:02:55 2006 From: dlah at common-lisp.net (dlah) Date: Thu, 9 Mar 2006 05:02:55 -0500 (EST) Subject: [Cl-fltk-cvs] CVS cl-fltk/wrapper Message-ID: <20060309100255.9DD047086@common-lisp.net> Update of /project/cl-fltk/cvsroot/cl-fltk/wrapper In directory clnet:/tmp/cvs-serv19130/wrapper Modified Files: widget.cc widget.h Log Message: --- /project/cl-fltk/cvsroot/cl-fltk/wrapper/widget.cc 2006/03/02 07:24:21 1.2 +++ /project/cl-fltk/cvsroot/cl-fltk/wrapper/widget.cc 2006/03/09 10:02:55 1.3 @@ -150,3 +150,73 @@ debug("%s:%s %x %c\n", __FILE__, __FUNCTION__, (unsigned int)widget, c); return widget->scrollbar_width(c); } + +Color fl_widget_get_color(Widget* widget) +{ + return widget->color(); +} + +Color fl_widget_get_textcolor(Widget* widget) +{ + return widget->textcolor(); +} + +Color fl_widget_get_selection_color(Widget* widget) +{ + return widget->selection_color(); +} + +Color fl_widget_get_selection_textcolor(Widget* widget) +{ + return widget->selection_textcolor(); +} + +Color fl_widget_get_buttoncolor(Widget* widget) +{ + return widget->buttoncolor(); +} + +Color fl_widget_get_labelcolor(Widget* widget) +{ + return widget->labelcolor(); +} + +Color fl_widget_get_highlight_color(Widget* widget) +{ + return widget->highlight_color(); +} + +Color fl_widget_get_highlight_textcolor(Widget* widget) +{ + return widget->highlight_textcolor(); +} + +float fl_widget_get_labelsize(Widget* widget) +{ + return widget->labelsize(); +} + +float fl_widget_get_textsize(Widget* widget) +{ + return widget->textsize(); +} + +float fl_widget_get_leading(Widget* widget) +{ + return widget->leading(); +} + +unsigned char fl_widget_get_scrollbar_align(Widget* widget) +{ + return widget->scrollbar_align(); +} + +unsigned char fl_widget_get_scrollbar_width(Widget* widget) +{ + return widget->scrollbar_width(); +} + +int fl_widget_send(Widget* widget, int event) +{ + return widget->send(event); +} --- /project/cl-fltk/cvsroot/cl-fltk/wrapper/widget.h 2006/03/02 07:24:21 1.2 +++ /project/cl-fltk/cvsroot/cl-fltk/wrapper/widget.h 2006/03/09 10:02:55 1.3 @@ -35,24 +35,23 @@ void fl_widget_leading(Widget* widget, float a); void fl_widget_scrollbar_align(Widget* widget, unsigned char); void fl_widget_scrollbar_width(Widget* widget, unsigned char); - /* - Color color() const; - Color textcolor() const; - Color selection_color() const; - Color selection_textcolor() const; - Color buttoncolor() const; - Color labelcolor() const; - Color highlight_color() const; - Color highlight_textcolor() const; - float labelsize() const; - float textsize() const; - float leading() const; - unsigned char scrollbar_align() const; - unsigned char scrollbar_width() const; - */ - /* - int send(int event); + Color fl_widget_get_color(Widget* widget); + Color fl_widget_get_textcolor(Widget* widget); + Color fl_widget_get_selection_color(Widget* widget); + Color fl_widget_get_selection_textcolor(Widget* widget); + Color fl_widget_get_buttoncolor(Widget* widget); + Color fl_widget_get_labelcolor(Widget* widget); + Color fl_widget_get_highlight_color(Widget* widget); + Color fl_widget_get_highlight_textcolor(Widget* widget); + float fl_widget_get_labelsize(Widget* widget); + float fl_widget_get_textsize(Widget* widget); + float fl_widget_get_leading(Widget* widget); + unsigned char fl_widget_get_scrollbar_align(Widget* widget); + unsigned char fl_widget_get_scrollbar_width(Widget* widget); + int fl_widget_send(Widget* widget, int event); + + /* const Style* style() const { return style_; } void style(const Style* s) { style_ = s; } void style(const Style& s) { style_ = &s; } From dlah at common-lisp.net Thu Mar 9 10:02:55 2006 From: dlah at common-lisp.net (dlah) Date: Thu, 9 Mar 2006 05:02:55 -0500 (EST) Subject: [Cl-fltk-cvs] CVS cl-fltk/src Message-ID: <20060309100255.9A53F7088@common-lisp.net> 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))