#lang racket
(require
 ffi/unsafe
 "base.rkt")

(define libiup
  (case (system-type 'os)
    [(windows)
     (ffi-lib "iup")]
    [else
     (ffi-lib "libiup")]))

(define libiup-controls
  (case (system-type 'os)
    [(windows)
     (ffi-lib "iupcontrols")]
    [else
     (ffi-lib "libiupcontrols")]))

;; Standard controls

(define canvas
  (make-constructor-procedure
   (get-ffi-obj
    "IupCanvas" libiup
    (_fun ([action #f]) :: [action : _iname/upcase] -> [handle : _ihandle]))))

(define frame
  (make-constructor-procedure
   (get-ffi-obj
    "IupFrame" libiup
    (_fun ([child #f]) :: [child : _ihandle/null] -> [handle : _ihandle]))))

(define tabs
  (make-constructor-procedure
   (get-ffi-obj
    "IupTabsv" libiup
    (_fun children :: [children : (_list i _ihandle/null) = (append children '(#f))]
          -> [handle : _ihandle]))))

(define label
  (make-constructor-procedure
   (get-ffi-obj
    "IupLabel" libiup
    (_fun ([title #f]) :: [title : _string/utf-8] -> [handle : _ihandle]))))

(define button
  (make-constructor-procedure
   (get-ffi-obj
    "IupButton" libiup
    (_fun ([title #f] [action #f]) :: [title : _string/utf-8] [action : _iname/upcase]
          -> [handle : _ihandle]))))

(define toggle
  (make-constructor-procedure
   (get-ffi-obj
    "IupToggle" libiup
    (_fun ([title #f] [action #f]) :: [title : _string/utf-8] [action : _iname/upcase]
          -> [handle : _ihandle]))))

(define spin
  (make-constructor-procedure
   (get-ffi-obj
    "IupSpin" libiup
    (_fun -> [handle : _ihandle]))))

(define spinbox
  (make-constructor-procedure
   (get-ffi-obj
    "IupSpinbox" libiup
    (_fun [child : _ihandle/null] -> [handle : _ihandle]))))

(define valuator
  (make-constructor-procedure
   (get-ffi-obj
    "IupVal" libiup
    (_fun ([type "HORIZONTAL"]) :: [type : _string/utf-8] -> [handle : _ihandle]))))

(define textbox
  (make-constructor-procedure
   (get-ffi-obj
    "IupText" libiup
    (_fun ([action #f]) :: [action : _iname/upcase] -> [handle : _ihandle]))))

(define listbox
  (make-constructor-procedure
   (get-ffi-obj
    "IupList" libiup
    (_fun ([action #f]) :: [action : _iname/upcase] -> [handle : _ihandle]))))

(define treebox
  (make-constructor-procedure
   (get-ffi-obj
    "IupTree" libiup
    (_fun -> [handle : _ihandle]))))

(define progress-bar
  (make-constructor-procedure
   (get-ffi-obj
    "IupProgressBar" libiup
    (_fun -> [handle : _ihandle]))))

;; Extended controls

(define matrix
  (make-constructor-procedure
   (get-ffi-obj
    "IupMatrix" libiup-controls
    (_fun ([action #f]) :: [action : _iname/upcase] -> [handle : _ihandle]))))

(define cells
  (make-constructor-procedure
   (get-ffi-obj
    "IupCells" libiup-controls
    (_fun -> [handle : _ihandle]))))

(define color-bar
  (make-constructor-procedure
   (get-ffi-obj
    "IupColorbar" libiup-controls
    (_fun -> [handle : _ihandle]))))

(define color-browser
  (make-constructor-procedure
   (get-ffi-obj
    "IupColorBrowser" libiup-controls
    (_fun -> [handle : _ihandle]))))

(define dial
  (make-constructor-procedure
   (get-ffi-obj
    "IupDial" libiup-controls
    (_fun ([type "HORIZONTAL"]) :: [type : _string/utf-8] -> [handle : _ihandle]))))

;; Library setup
  
(letrec ([open
          (get-ffi-obj
           "IupControlsOpen" libiup-controls
             (_fun -> [status : _istatus]
                   -> (case status
                        [(#t ignore) (void)]
                        [else        (error 'controls "failed to initialize library (~s)" status)])))])
  (open))

(provide
 canvas
 frame tabs
 label button toggle
 spin spinbox valuator
 textbox listbox treebox
 progress-bar
 matrix cells
 color-bar color-browser
 dial)