[Cl-fltk-cvs] CVS cl-fltk/src - cl-fltk-cvs@common-lisp.net - mailman3.common-lisp.net

27 Feb 2006


      Update of /project/cl-fltk/cvsroot/cl-fltk/src
In directory clnet:/tmp/cvs-serv18184/src
Added Files:
    ask.lisp button.lisp cl-fltk.lisp color.lisp flags.lisp 
    group.lisp package.lisp progressbar.lisp run.lisp style.lisp 
    widget.lisp window.lisp 
Log Message:
Initial import
--- /project/cl-fltk/cvsroot/cl-fltk/src/ask.lisp	2006/02/27 08:26:41	NONE
+++ /project/cl-fltk/cvsroot/cl-fltk/src/ask.lisp	2006/02/27 08:26:41	1.1
(in-package #:cl-fltk)
(defun ask (text)
    (cffi:foreign-funcall "fl_ask_ask"
    		  :pointer (cffi:foreign-string-alloc text)
    		  :int))
--- /project/cl-fltk/cvsroot/cl-fltk/src/button.lisp	2006/02/27 08:26:41	NONE
+++ /project/cl-fltk/cvsroot/cl-fltk/src/button.lisp	2006/02/27 08:26:41	1.1
(in-package #:cl-fltk)
(defclass Button (Widget)
  ())
(defun new-button (x y width height text)
  (let ((button-instance (make-instance 'Button )))
    (setf (slot-value button-instance 'foreign-object)
      (cffi:foreign-funcall "new_button"
    			:int x
    			:int y
    			:int width
    			:int height
    			:pointer (cffi:foreign-string-alloc text) :pointer))
    button-instance))
--- /project/cl-fltk/cvsroot/cl-fltk/src/cl-fltk.lisp	2006/02/27 08:26:41	NONE
+++ /project/cl-fltk/cvsroot/cl-fltk/src/cl-fltk.lisp	2006/02/27 08:26:41	1.1
(in-package #:cl-fltk)
(defclass cl-fltk-object ()
  ((foreign-object :accessor foreign-object)))
(cffi:define-foreign-library libcl-fltk
    (:darwin "wrapper/libcl-fltk.so")
    (:unix "wrapper/libcl-fltk.so"))
(cffi:load-foreign-library 'libcl-fltk)
--- /project/cl-fltk/cvsroot/cl-fltk/src/color.lisp	2006/02/27 08:26:41	NONE
+++ /project/cl-fltk/cvsroot/cl-fltk/src/color.lisp	2006/02/27 08:26:41	1.1
(in-package #:cl-fltk)
(defconstant +NO_COLOR+ 0)
(defconstant +GRAY00+ 32)
(defconstant +GRAY05+ 33)
(defconstant +GRAY10+ 34)
(defconstant +GRAY15+ 35)
(defconstant +GRAY20+ 36)
(defconstant +GRAY25+ 37)
(defconstant +GRAY30+ 38)
(defconstant +GRAY33+ 39)
(defconstant +GRAY35+ 40)
(defconstant +GRAY40+ 41)
(defconstant +GRAY45+ 42)
(defconstant +GRAY50+ 43)
(defconstant +GRAY55+ 44)
(defconstant +GRAY60+ 45)
(defconstant +GRAY65+ 46)
(defconstant +GRAY66+ 47)
(defconstant +GRAY70+ 48)
(defconstant +GRAY75+ 49)
(defconstant +GRAY80+ 50)
(defconstant +GRAY85+ 51)
(defconstant +GRAY90+ 53)
(defconstant +GRAY95+ 54)
(defconstant +GRAY99+ 55)
(defconstant +BLACK+ #x38)
(defconstant +RED+ #x58)
(defconstant +GREEN+ #x3F)
(defconstant +YELLOW+ #x5F)
(defconstant +BLUE+ #xD8)
(defconstant +MAGENTA+ #xF8)
(defconstant +CYAN+ #xDF)
(defconstant +WHITE+ #xFF)
(defconstant +WINDOWS_BLUE+ #x88)
;inline Color color(unsigned char r, unsigned char g, unsigned char b) {
;FL_API Color color(const char*);
;FL_API Color lerp(Color c0, Color c1, float f);
;FL_API Color inactive(Color);
;FL_API Color inactive(Color, Flags f);
;FL_API Color contrast(Color fg, Color bg);
;FL_API void split_color(Color c, unsigned char& r, unsigned char& g, unsigned char& b);
;FL_API void set_color_index(Color index, Color);
;FL_API Color get_color_index(Color index);
;FL_API void set_background(Color);
;FL_API Color nearest_index(Color);
--- /project/cl-fltk/cvsroot/cl-fltk/src/flags.lisp	2006/02/27 08:26:41	NONE
+++ /project/cl-fltk/cvsroot/cl-fltk/src/flags.lisp	2006/02/27 08:26:41	1.1
(in-package #:cl-fltk)
(defconstant +NO-FLAGS+ 0)
(defconstant +ALIGNCENTER+ 0)
(defconstant +ALIGN-TOP+ 1)
(defconstant +ALIGN-BOTTOM+ 2)
(defconstant +ALIGN-LEFTTOP+ 3)
(defconstant +ALIGN-LEFT+ 4)
(defconstant +ALIGN-TOPLEFT+ 5)
(defconstant +ALIGN-BOTTOMLEFT+ 6)
(defconstant +ALIGN-LEFTBOTTOM+ 7)
(defconstant +ALIGN-RIGHT+ 8)
(defconstant +ALIGN-TOPRIGHT+ 9)
(defconstant +ALIGN-BOTTOMRIGHT+ 10)
(defconstant +ALIGN-RIGHTTOP+ 11)
(defconstant +ALIGN-CENTERLEFT+ 12)
(defconstant +ALIGN-RIGHTBOTTOM+ 15)
(defconstant +ALIGN-INSIDE+ 16)
(defconstant +ALIGN-INSIDE-TOP+ 17)
(defconstant +ALIGN-INSIDE-BOTTOM+ 18)
(defconstant +ALIGN-INSIDE-LEFT+ 20)
(defconstant +ALIGN-INSIDE-TOPLEFT+ 21)
(defconstant +ALIGN-INSIDE-BOTTOMLEFT+ 22)
(defconstant +ALIGN-INSIDE-RIGHT+ 24)
(defconstant +ALIGN-INSIDE-TOPRIGHT+ 25)
(defconstant +ALIGN-INSIDE-BOTTOMRIGHT+ 26)
(defconstant +ALIGN-CLIP+ #x00000040)
(defconstant +ALIGN-WRAP+ #x00000080)
(defconstant +ALIGN-MASK+ #x000000FF)
(defconstant +NOTACTIVE+ #x00000100)
(defconstant +OUTPUT+ #x00000200)
(defconstant +VALUE+ #x00000400)
(defconstant +SELECTED+ #x00000800)
(defconstant +INVISIBLE+ #x00001000)
(defconstant +HIGHLIGHT+ #x00002000)
(defconstant +CHANGED+ #x00004000)
(defconstant +COPIED-LABEL+ #x00008000)
(defconstant +RAW-LABEL+ #x00010000)
(defconstant +LAYOUT-VERTICAL+ #x00020000)
(defconstant +TAB-TO-FOCUS+ #x00040000)
(defconstant +CLICK-TO-FOCUS+ #x00080000)
(defconstant +INACTIVE+ #x00100000)
(defconstant +FOCUSED+ #x00200000)
(defconstant +PUSHED+ #x00400000)
--- /project/cl-fltk/cvsroot/cl-fltk/src/group.lisp	2006/02/27 08:26:41	NONE
+++ /project/cl-fltk/cvsroot/cl-fltk/src/group.lisp	2006/02/27 08:26:41	1.1
(in-package #:cl-fltk)
(defclass Group (Widget)
  ())
(defgeneric begin (group))
(defmethod begin ((group Group))
  (cffi:foreign-funcall "fl_group_begin" :pointer (foreign-object group)))
(defgeneric end (group))
(defmethod end ((group Group))
  (cffi:foreign-funcall "fl_group_end" :pointer (foreign-object group)))
--- /project/cl-fltk/cvsroot/cl-fltk/src/package.lisp	2006/02/27 08:26:41	NONE
+++ /project/cl-fltk/cvsroot/cl-fltk/src/package.lisp	2006/02/27 08:26:41	1.1
(in-package #:cl-user)
(defpackage #:cl-fltk
  (:use #:common-lisp)
  (:nicknames fl fltk)
  (:export
   ProgressBar
   +BORDER-BOX+
   +BORDER-FRAME+
   +COURIER+
   +COURIER-BOLD+
   +COURIER-BOLD-ITALIC+
   +COURIER-ITALIC+
   +DIAMOND-DOWN-BOX+
   +DIAMOND-UP-BOX+
   +DOTTED-FRAME+
   +DOWN-BOX+
   +EMBOSSED-BOX+
   +EMBOSSED-LABEL+
   +ENGRAVED-BOX+
   +ENGRAVED-LABEL+
   +FLAT-BOX+
   +HELVETICA+
   +HELVETICA-BOLD+
   +HELVETICA-BOLD-ITALIC+
   +HELVETICA-ITALIC+
   +HIGHLIGHT-DOWN-BOX+
   +HIGHLIGHT-UP-BOX+
   +NO-BOX+
   +NO-LABEL+
   +NORMAL-LABEL+
   +OFLAT-BOX+
   +OSHADOW-BOX+
   +OVAL-BOX+
   +PLASTIC-DOWN-BOX+
   +PLASTIC-UP-BOX+
   +RFLAT-BOX+
   +ROUND-DOWN-BOX+
   +ROUND-UP-BOX+
   +ROUNDED-BOX+
   +RSHADOW-BOX+
   +SCREEN-BOLD-FONT+
   +SCREEN-FONT+
   +SHADOW-BOX+
   +SHADOW-LABEL+
   +SYMBOL-FONT+
   +SYMBOL-LABEL+
   +THIN-DOWN-BOX+
   +THIN-UP-BOX+
   +TIMES+
   +TIMES-BOLD+
   +TIMES-BOLD-ITALIC+
   +TIMES-ITALIC+
   +UP-BOX+
   +ZAPF-DINGBATS+
   ask
   begin
   box
   callback
   end
   foreign-object
   hide
   labelfont
   labelsize
   labeltype
   new-button
   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
   ))
--- /project/cl-fltk/cvsroot/cl-fltk/src/progressbar.lisp	2006/02/27 08:26:41	NONE
+++ /project/cl-fltk/cvsroot/cl-fltk/src/progressbar.lisp	2006/02/27 08:26:41	1.1
(in-package #:cl-fltk)
(defclass ProgressBar (Widget)
  ())
(defun new-progressbar (x y width height lbl)
  (let ((progressbar-instance (make-instance 'ProgressBar )))
    (setf (slot-value progressbar-instance 'foreign-object)
      (cffi:foreign-funcall "new_progressbar"
    			:int x
    			:int y
    			:int width
    			:int height
    			:pointer (cffi:foreign-string-alloc lbl) :pointer))
    progressbar-instance))
;;min int max int should be double
(defmethod range ((pb ProgressBar) (min double-float) (max double-float) &optional (step 1.0D0))
  (cffi:foreign-funcall "fl_progressbar_range"
    		:pointer (cl-fltk:foreign-object pb)
    		:double min
    		: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))
;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"
    		    :pointer (cl-fltk:foreign-object pb)
    		    :double position))
      (cffi:foreign-funcall "fl_progressbar_get_position"
    		    :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);
--- /project/cl-fltk/cvsroot/cl-fltk/src/run.lisp	2006/02/27 08:26:41	NONE
+++ /project/cl-fltk/cvsroot/cl-fltk/src/run.lisp	2006/02/27 08:26:41	1.1
(in-package #:cl-fltk)
(defun run ()
  (cffi:foreign-funcall "fl_run"))
(defun add-timeout (timeout handler v)
  (cffi:foreign-funcall "fl_run_add_timeout"
    		:float timeout
    		:pointer (cffi:foreign-alloc :pointer :initial-element (cffi:get-callback handler))
    		:pointer v))
--- /project/cl-fltk/cvsroot/cl-fltk/src/style.lisp	2006/02/27 08:26:41	NONE
+++ /project/cl-fltk/cvsroot/cl-fltk/src/style.lisp	2006/02/27 08:26:41	1.1
(in-package #:cl-fltk)
(cffi:defcvar ("__UP_BOX" +UP-BOX+) :pointer)
(cffi:defcvar ("__DOWN_BOX" +DOWN-BOX+) :pointer)
(cffi:defcvar ("__THIN_UP_BOX" +THIN-UP-BOX+) :pointer)
(cffi:defcvar ("__THIN_DOWN_BOX" +THIN-DOWN-BOX+) :pointer)
(cffi:defcvar ("__ENGRAVED_BOX" +ENGRAVED-BOX+) :pointer)
(cffi:defcvar ("__EMBOSSED_BOX" +EMBOSSED-BOX+) :pointer)
(cffi:defcvar ("__BORDER_BOX" +BORDER-BOX+) :pointer)
(cffi:defcvar ("__FLAT_BOX" +FLAT-BOX+) :pointer)
(cffi:defcvar ("__HIGHLIGHT_UP_BOX" +HIGHLIGHT-UP-BOX+) :pointer)
(cffi:defcvar ("__HIGHLIGHT_DOWN_BOX" +HIGHLIGHT-DOWN-BOX+) :pointer)
(cffi:defcvar ("__ROUND_UP_BOX" +ROUND-UP-BOX+) :pointer)
(cffi:defcvar ("__ROUND_DOWN_BOX" +ROUND-DOWN-BOX+) :pointer)
(cffi:defcvar ("__DIAMOND_UP_BOX" +DIAMOND-UP-BOX+) :pointer)
(cffi:defcvar ("__DIAMOND_DOWN_BOX" +DIAMOND-DOWN-BOX+) :pointer)
(cffi:defcvar ("__NO_BOX" +NO-BOX+) :pointer)
(cffi:defcvar ("__SHADOW_BOX" +SHADOW-BOX+) :pointer)
(cffi:defcvar ("__ROUNDED_BOX" +ROUNDED-BOX+) :pointer)
(cffi:defcvar ("__RSHADOW_BOX" +RSHADOW-BOX+) :pointer)
(cffi:defcvar ("__RFLAT_BOX" +RFLAT-BOX+) :pointer)
(cffi:defcvar ("__OVAL_BOX" +OVAL-BOX+) :pointer)
(cffi:defcvar ("__OSHADOW_BOX" +OSHADOW-BOX+) :pointer)
(cffi:defcvar ("__OFLAT_BOX" +OFLAT-BOX+) :pointer)
(cffi:defcvar ("__BORDER_FRAME" +BORDER-FRAME+) :pointer)
(cffi:defcvar ("__DOTTED_FRAME" +DOTTED-FRAME+) :pointer)
(cffi:defcvar ("__PLASTIC_UP_BOX" +PLASTIC_UP-BOX+) :pointer)
(cffi:defcvar ("__PLASTIC_DOWN_BOX" +PLASTIC-DOWN-BOX+) :pointer)
(cffi:defcvar ("__HELVETICA" +HELVETICA+) :pointer)
(cffi:defcvar ("__HELVETICA_BOLD" +HELVETICA-BOLD+) :pointer)
(cffi:defcvar ("__HELVETICA_ITALIC" +HELVETICA-ITALIC+) :pointer)
(cffi:defcvar ("__HELVETICA_BOLD_ITALIC" +HELVETICA-BOLD-ITALIC+) :pointer)
(cffi:defcvar ("__COURIER" +COURIER+) :pointer)
(cffi:defcvar ("__COURIER_BOLD" +COURIER-BOLD+) :pointer)
(cffi:defcvar ("__COURIER_ITALIC" +COURIER-ITALIC+) :pointer)
(cffi:defcvar ("__COURIER_BOLD_ITALIC" +COURIER-BOLD-ITALIC+) :pointer)
(cffi:defcvar ("__TIMES" +TIMES+) :pointer)
(cffi:defcvar ("__TIMES_BOLD" +TIMES-BOLD+) :pointer)
(cffi:defcvar ("__TIMES_ITALIC" +TIMES-ITALIC+) :pointer)
(cffi:defcvar ("__TIMES_BOLD_ITALIC" +TIMES-BOLD-ITALIC+) :pointer)
(cffi:defcvar ("__SYMBOL_FONT" +SYMBOL-FONT+) :pointer)
(cffi:defcvar ("__SCREEN_FONT" +SCREEN-FONT+) :pointer)
(cffi:defcvar ("__SCREEN_BOLD_FONT" +SCREEN-BOLD-FONT+) :pointer)
(cffi:defcvar ("__ZAPF_DINGBATS" +ZAPF-DINGBATS+) :pointer)
(cffi:defcvar ("__NO_LABEL" +NO-LABEL+) :pointer)
(cffi:defcvar ("__NORMAL_LABEL" +NORMAL-LABEL+) :pointer)
(cffi:defcvar ("__SYMBOL_LABEL" +SYMBOL-LABEL+) :pointer)
(cffi:defcvar ("__SHADOW_LABEL" +SHADOW-LABEL+) :pointer)
(cffi:defcvar ("__ENGRAVED_LABEL" +ENGRAVED-LABEL+) :pointer)
[2 lines skipped]
--- /project/cl-fltk/cvsroot/cl-fltk/src/widget.lisp	2006/02/27 08:26:41	NONE
+++ /project/cl-fltk/cvsroot/cl-fltk/src/widget.lisp	2006/02/27 08:26:41	1.1
[89 lines skipped]
--- /project/cl-fltk/cvsroot/cl-fltk/src/window.lisp	2006/02/27 08:26:41	NONE
+++ /project/cl-fltk/cvsroot/cl-fltk/src/window.lisp	2006/02/27 08:26:41	1.1
[111 lines skipped]