[Cl-fltk-cvs] CVS cl-fltk/test

[dlah]

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)