xosd.ss
#lang scheme
(require
 scheme/foreign
 (only-in scheme/contract [-> ->/c]))

(unsafe!)

(define libxosd
  (ffi-lib "libxosd"))

(define-cpointer-type _xosd _pointer)

(provide/contract
 [xosd? (any/c . ->/c . any/c)])

(define make-xosd
  (get-ffi-obj
   "xosd_create" libxosd
   (_fun [lines : _int]
         -> [xosd : _xosd/null]
         -> (if xosd
                (begin
                  (register-finalizer xosd xosd-uninit!)
                  xosd)
                #f))))

(define xosd-uninit!
  (get-ffi-obj
   "xosd_uninit" libxosd
   (_fun [xosd : _xosd] -> _void)))

(provide/contract
 [make-xosd (exact-positive-integer? . ->/c . (or/c xosd? #f))])

(define xosd-onscreen?
  (get-ffi-obj
   "xosd_is_onscreen" libxosd
   (_fun [xosd : _xosd] -> [onscreen? : _bool])))

(define xosd-hide
  (get-ffi-obj
   "xosd_hide" libxosd
   (_fun [xosd : _xosd] -> [ok : _int] -> (zero? ok))))

(define xosd-show
  (get-ffi-obj
   "xosd_show" libxosd
   (_fun [xosd : _xosd] -> [ok : _int] -> (zero? ok))))

(define xosd-wait-until-no-display
  (get-ffi-obj
   "xosd_wait_until_no_display" libxosd
   (_fun [xosd : _xosd] -> _void)))

(provide/contract
 [xosd-onscreen? (xosd? . ->/c . boolean?)]
 [xosd-hide (xosd? . ->/c . boolean?)]
 [xosd-show (xosd? . ->/c . boolean?)]
 [xosd-wait-until-no-display (xosd? . ->/c . void?)])

(define _xosd-pos
  (_enum '(top bottom middle)))

(define set-xosd-pos!
  (get-ffi-obj
   "xosd_set_pos" libxosd
   (_fun [xosd : _xosd] [pos : _xosd-pos] -> _void)))

(define _xosd-align
  (_enum '(left center right)))

(define set-xosd-align!
  (get-ffi-obj
   "xosd_set_align" libxosd
   (_fun [xosd : _xosd] [align : _xosd-align] -> _void)))

(define set-xosd-horizontal-offset!
  (get-ffi-obj
   "xosd_set_horizontal_offset" libxosd
   (_fun [xosd : _xosd] [offset : _int] -> _void)))

(define set-xosd-vertical-offset!
  (get-ffi-obj
   "xosd_set_vertical_offset" libxosd
   (_fun [xosd : _xosd] [offset : _int] -> _void)))

(define set-xosd-color!
  (get-ffi-obj
   "xosd_set_colour" libxosd
   (_fun [xosd : _xosd] [color : _string/utf-8]
         -> [ok : _int]
         -> (zero? ok))))

(define set-xosd-font!
  (get-ffi-obj
   "xosd_set_font" libxosd
   (_fun [xosd : _xosd] [font : _string/utf-8]
         -> [ok : _int]
         -> (zero? ok))))

(define set-xosd-shadow-color!
  (get-ffi-obj
   "xosd_set_shadow_colour" libxosd
   (_fun [xosd : _xosd] [colour : _string/utf-8]
         -> [ok : _int]
         -> (zero? ok))))

(define set-xosd-shadow-offset!
  (get-ffi-obj
   "xosd_set_shadow_offset" libxosd
   (_fun [xosd : _xosd] [offset : _int] -> _void)))

(define set-xosd-outline-color!
  (get-ffi-obj
   "xosd_set_outline_colour" libxosd
   (_fun [xosd : _xosd] [colour : _string/utf-8]
         -> [ok : _int]
         -> (zero? ok))))

(define set-xosd-outline-offset!
  (get-ffi-obj
   "xosd_set_outline_offset" libxosd
   (_fun [xosd : _xosd] [offset : _int] -> _void)))

(define set-xosd-bar-length!
  (get-ffi-obj
   "xosd_set_bar_length" libxosd
   (_fun (xosd length)
         :: [_xosd = xosd] [_int = (or length -1)]
         -> _void)))

(define set-xosd-timeout!
  (get-ffi-obj
   "xosd_set_timeout" libxosd
   (_fun (xosd timeout)
         :: [_xosd = xosd] [_int = (or timeout -1)] -> _void)))

(provide/contract
 [set-xosd-pos! (xosd? symbol? . ->/c . void?)]
 [set-xosd-align! (xosd? symbol? . ->/c . void?)]
 [set-xosd-horizontal-offset! (xosd? exact-nonnegative-integer? . ->/c . void?)]
 [set-xosd-vertical-offset! (xosd? exact-nonnegative-integer? . ->/c . void?)]
 [set-xosd-color! (xosd? string? . ->/c . boolean?)]
 [set-xosd-font! (xosd? string? . ->/c . boolean?)]
 [set-xosd-shadow-color! (xosd? string? . ->/c . boolean?)]
 [set-xosd-shadow-offset! (xosd? exact-nonnegative-integer? . ->/c . void?)]
 [set-xosd-outline-color! (xosd? string? . ->/c . boolean?)]
 [set-xosd-outline-offset! (xosd? exact-nonnegative-integer? . ->/c . void?)]
 [set-xosd-bar-length!
  (xosd? (or/c exact-nonnegative-integer? #f) . ->/c . void?)]
 [set-xosd-timeout!
  (xosd? (or/c exact-nonnegative-integer? #f) . ->/c . void?)])

(define xosd-lines
  (get-ffi-obj
   "xosd_get_number_lines" libxosd
   (_fun [xosd : _xosd] -> [lines : _int])))

(define xosd-color
  (get-ffi-obj
   "xosd_get_colour" libxosd
   (_fun [xosd : _xosd]
         [red : (_ptr o _int)]
         [green : (_ptr o _int)]
         [blue : (_ptr o _int)]
         -> _void
         -> (values red green blue))))

(provide/contract
 [xosd-lines (xosd? . ->/c . exact-positive-integer?)]
 [xosd-color (xosd? . ->/c . (values exact-nonnegative-integer?
                                     exact-nonnegative-integer?
                                     exact-nonnegative-integer?))])

(define xosd-scroll
  (get-ffi-obj
   "xosd_scroll" libxosd
   (_fun [xosd : _xosd] [lines : _int] -> _void)))

(define _xosd-command
  (_enum '(percentage string printf slider)))

(define xosd-display-percentage
  (get-ffi-obj
   "xosd_display" libxosd
   (_fun [xosd : _xosd]
         [line : _int]
         [command : _xosd-command = 'percentage]
         [percentage : _int]
         -> _void)))

(define xosd-display-slider
  (get-ffi-obj
   "xosd_display" libxosd
   (_fun [xosd : _xosd]
         [line : _int]
         [command : _xosd-command = 'slider]
         [percentage : _int]
         -> _void)))

(define xosd-display-string
  (get-ffi-obj
   "xosd_display" libxosd
   (_fun [xosd : _xosd]
         [line : _int]
         [command : _xosd-command = 'string]
         [str : _string/utf-8]
         -> _void)))

(define xosd-display-format
  (get-ffi-obj
   "xosd_display" libxosd
   (_fun (xosd line fmt . args) ::
         [_xosd = xosd]
         [_int = line]
         [command : _xosd-command = 'string]
         [str : _string/utf-8 = (apply format fmt args)]
         -> _void)))

(define percentage/c
  (integer-in 0 100))

(provide/contract
 [xosd-scroll (xosd? exact-nonnegative-integer? . ->/c . void?)]
 [xosd-display-percentage
  (xosd? exact-nonnegative-integer? percentage/c . ->/c . void?)]
 [xosd-display-slider
  (xosd? exact-nonnegative-integer? percentage/c . ->/c . void?)]
 [xosd-display-string
  (xosd? exact-nonnegative-integer? string? . ->/c . void?)]
 [xosd-display-format
  ((xosd? exact-nonnegative-integer? string?) () #:rest any/c . ->* . void?)])