#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")]))

(define libiup-matrixex
  (case (system-type 'os)
    [(windows)
     (ffi-lib "iupmatrixex" #:fail (λ () #f))]
    [else
     (ffi-lib "libiupmatrixex" #:fail (λ () #f))]))

;; 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 link
  (make-constructor-procedure
   (get-ffi-obj
    "IupLink" libiup
    (_fun ([url #f] [title #f]) :: [url : _string/utf-8] [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
  (letrec ([create
            (get-ffi-obj
             "IupMatrix" libiup-controls
             (_fun [action : _iname/upcase] -> [handle : _ihandle]))]
           [extend!
            (and
             libiup-matrixex
             (get-ffi-obj
              "IupMatrixExInit" libiup-matrixex
              (_fun [handle : _ihandle] -> _void)))])
    (make-constructor-procedure
     (λ ([action #f] [extended? #t])
       (let ([handle (create action)])
         (when (and extend! extended?) (extend! handle))
         handle)))))

(define matrix-listbox
  (make-constructor-procedure
   (get-ffi-obj
    "IupMatrixList" libiup-controls
    (_fun -> [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)])))]
         [matrixex
          (and
           libiup-matrixex
           (get-ffi-obj
            "IupMatrixExOpen" libiup-matrixex
            (_fun -> _void)))])
  (open)
  (when matrixex (matrixex)))

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