
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)