Update of /project/cl-fltk/cvsroot/cl-fltk/test In directory clnet:/tmp/cvs-serv18184/test
Added Files: button.lisp hello.lisp helloask.lisp progressbar.lisp Log Message: Initial import
--- /project/cl-fltk/cvsroot/cl-fltk/test/button.lisp 2006/02/27 08:26:41 NONE +++ /project/cl-fltk/cvsroot/cl-fltk/test/button.lisp 2006/02/27 08:26:41 1.1 (require :asdf) (asdf:operate 'asdf:load-op 'cffi) (asdf:operate 'asdf:load-op 'cl-fltk)
(defvar window) (defvar b1) (defvar b2) (defvar b3)
(cffi:defcallback beepcb :void ((widget :pointer) (data :pointer)) (format t "beep!~%"))
(cffi:defcallback exitcb :void ((widget :pointer) (data :pointer)) (quit))
(setf window (fl:new-window 320 65 "bla")) (fl:begin window)
(setf b1 (fl:new-button 20 20 80 25 "&Beep")) (fl:callback b1 'beepcb 0)
(setf b2 (fl:new-button 120 20 80 25 "&no op"))
(setf b3 (fl:new-button 220 20 80 25 "E&xit")) (fl:callback b3 'exitcb 0)
(fl:end window) (fl:show window)
(fl::run) (quit) --- /project/cl-fltk/cvsroot/cl-fltk/test/hello.lisp 2006/02/27 08:26:41 NONE +++ /project/cl-fltk/cvsroot/cl-fltk/test/hello.lisp 2006/02/27 08:26:41 1.1 (require :asdf) (asdf:operate 'asdf:load-op 'cffi) (asdf:operate 'asdf:load-op 'cl-fltk)
(defvar window) (defvar box)
(setf window (cl-fltk:new-window 300 180 "bla")) (cl-fltk:begin window)
(setf box (cl-fltk:new-widget 20 40 260 100 "Hello, World!"))
(cl-fltk:box box cl-fltk:+UP-BOX+) (cl-fltk:labelfont box cl-fltk:+HELVETICA-BOLD-ITALIC+) (cl-fltk:labelsize box 36.0) (cl-fltk:labeltype box cl-fltk:+SHADOW-LABEL+)
(cl-fltk:end window) (cl-fltk:show window)
(cl-fltk::run) (quit) --- /project/cl-fltk/cvsroot/cl-fltk/test/helloask.lisp 2006/02/27 08:26:41 NONE +++ /project/cl-fltk/cvsroot/cl-fltk/test/helloask.lisp 2006/02/27 08:26:41 1.1 (require :asdf) (asdf:operate 'asdf:load-op 'cffi) (asdf:operate 'asdf:load-op 'cl-fltk)
(defvar window) (defvar box)
(cffi:defcallback hello :void ((widget :pointer)) (if (= (cl-fltk:ask "Quit app?") 1) (cl-fltk:hide widget)))
(setf window (cl-fltk:new-window 300 180 "bla")) (cl-fltk:callback window 'hello) (cl-fltk:begin window)
(setf box (cl-fltk:new-widget 20 40 260 100 "Hello, World!"))
(cl-fltk:box box cl-fltk:+UP-BOX+) (cl-fltk:labelfont box cl-fltk:+HELVETICA-BOLD-ITALIC+) (cl-fltk:labelsize box 36.0) (cl-fltk:labeltype box cl-fltk:+SHADOW-LABEL+)
(cl-fltk:end window) (cl-fltk:show window)
(cl-fltk::run) (quit) --- /project/cl-fltk/cvsroot/cl-fltk/test/progressbar.lisp 2006/02/27 08:26:41 NONE +++ /project/cl-fltk/cvsroot/cl-fltk/test/progressbar.lisp 2006/02/27 08:26:41 1.1 (require :asdf) (asdf:operate 'asdf:load-op 'cffi) (asdf:operate 'asdf:load-op 'cl-fltk)
(defvar window) (defvar pbar)
(cffi:defcallback ptimer :void ((ignored :pointer)) (let ((position (fl:progressbar-position pbar))) (if (or (not position) (< position 100)) (progn (fl:progressbar-step pbar 1.0D0) (fl:add-timeout 0.1 'ptimer (cffi:null-pointer))) (fl:hide window))))
(setf window (fl:new-window 400 100 "ProgressBar Demo"))
(fl:begin window)
(setf pbar (fl:new-progressbar 25 25 330 25 "Simple Progress Bar"))
(fl:box pbar fl:+ENGRAVED-BOX+) (fl:clear-flag pbar fl:+ALIGN-MASK+) (fl:set-flag pbar fl:+ALIGN-BOTTOM+) (fl:selection-color pbar fl:+BLUE+) (fl:color pbar fl:+WHITE+) (fl:textcolor pbar fl:+RED+)
(fl:end window)
(fl:add-timeout 0.1 'ptimer (cffi:null-pointer))
(fl:show window)
(fl::run) (quit)
-
dlah