File iup/iup-controls.scm artifact 11955c7efc part of check-in c83183fa27

(require-library iup-base)

(module iup-controls
	(canvas
	 frame tabs
	 label button toggle
	 spin spinbox valuator
	 textbox listbox treebox
	 progress-bar
	 matrix cells
	 color-bar color-browser
	 dial)
	(import
		scheme chicken foreign
		iup-base)

;; {{{ Data types

(foreign-declare
	"#include <iup.h>\n"
	"#include <iupcontrols.h>\n")
	
(include "iup-types.scm")

;; }}}

;; {{{ Standard controls

(define canvas
	(make-constructor-procedure
		(foreign-lambda nonnull-ihandle "IupCanvas" iname/upcase)
		#:apply-args (optional-args [action #f])))

(define frame
	(make-constructor-procedure
		(foreign-lambda nonnull-ihandle "IupFrame" ihandle)
		#:apply-args (optional-args [action #f])))

(define tabs
  (make-constructor-procedure
  	(foreign-lambda* nonnull-ihandle ([ihandle-list handles])
  		"C_return(IupTabsv((Ihandle **)handles));")
  	#:apply-args list))

(define label
  (make-constructor-procedure
  	(foreign-lambda nonnull-ihandle "IupLabel" c-string)
  	#:apply-args (optional-args [action #f])))

(define button
  (make-constructor-procedure
  	(foreign-lambda nonnull-ihandle "IupButton" c-string iname/upcase)
  	#:apply-args (optional-args [title #f] [action #f])))

(define toggle
  (make-constructor-procedure
  	(foreign-lambda nonnull-ihandle "IupToggle" c-string iname/upcase)
  	#:apply-args (optional-args [title #f] [action #f])))

(define spin
  (make-constructor-procedure
  	(foreign-lambda nonnull-ihandle "IupSpin")))

(define spinbox
  (make-constructor-procedure
  	(foreign-lambda nonnull-ihandle "IupSpinbox" ihandle)))

(define valuator
  (make-constructor-procedure
  	(foreign-lambda nonnull-ihandle "IupVal" c-string)
  	#:apply-args (optional-args [type "HORIZONTAL"])))

(define textbox
  (make-constructor-procedure
  	(foreign-lambda nonnull-ihandle "IupText" iname/upcase)
  	#:apply-args (optional-args [action #f])))

(define listbox
  (make-constructor-procedure
  	(foreign-lambda nonnull-ihandle "IupList" iname/upcase)
  	#:apply-args (optional-args [action #f])))

(define treebox
  (make-constructor-procedure
  	(foreign-lambda nonnull-ihandle "IupTree")))

(define progress-bar
  (make-constructor-procedure
  	(foreign-lambda nonnull-ihandle "IupProgressBar")))

;; }}}

;; {{{ Extended controls

(define matrix
  (make-constructor-procedure
  	(foreign-lambda nonnull-ihandle "IupMatrix" iname/upcase)
  	#:apply-args (optional-args [action #f])))

(define cells
  (make-constructor-procedure
  	(foreign-lambda nonnull-ihandle "IupCells")))

(define color-bar
  (make-constructor-procedure
  	(foreign-lambda nonnull-ihandle "IupColorbar")))

(define color-browser
  (make-constructor-procedure
  	(foreign-lambda nonnull-ihandle "IupColorBrowser")))

(define dial
  (make-constructor-procedure
  	(foreign-lambda nonnull-ihandle "IupDial" c-string)
  	#:apply-args (optional-args [type "HORIZONTAL"])))

;; }}}

;; {{{ Library setup

(let ([status (foreign-value "IupControlsOpen()" istatus)])
	(case status
		[(#t ignore) (void)]
		[else        (error 'iup "failed to initialize library (~s)" status)]))

;; }}}

)