[Cl-fltk-cvs] CVS cl-fltk/src
dlah
dlah at common-lisp.net
Mon Feb 27 08:26:41 UTC 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]
More information about the Cl-fltk-cvs
mailing list