racket/collects/ffi/examples/xosd.rkt
2012-07-27 10:31:26 -04:00

105 lines
3.8 KiB
Racket

#lang racket/base
(require ffi/unsafe)
(define libxosd (ffi-lib "libxosd"))
;; Use this type to properly destroy an xosd object
(define _xosd (make-ctype (_cpointer "xosd") #f
(lambda (p)
(if p
(register-finalizer p xosd-destroy)
(error '_xosd "got a NULL pointer"))
p)))
(define-syntax defxosd
(syntax-rules (:)
[(_ name : type ...)
(define name
(get-ffi-obj (regexp-replaces 'name '((#rx"-" "_") (#rx"[*?]$" "")))
libxosd (_fun type ...)))]))
(define-syntax defxosd*
(syntax-rules ()
[(_ name x ...) (begin (provide name) (defxosd name x ...))]))
(define _status
(make-ctype _int #f
(lambda (x)
(if (eq? -1 x)
(error 'xosd "~a"
(or (get-ffi-obj "xosd_error" libxosd _string)
"unknown xosd error"))
x))))
(define _sbool
(make-ctype _status #f
(lambda (x)
(case x [(1) #t] [(0) #f] [else (error "bad boolean value: ~e" x)]))))
;; ===== Initializing =========================================================
(defxosd* xosd-create : ; [num-lines = 1] -> xosd-obj
args :: (num-lines : _int = (if (pair? args) (car args) 1)) -> _xosd)
(defxosd xosd-destroy : _xosd -> _int)
(defxosd* xosd-is-onscreen? : _xosd -> _sbool)
;; ===== Displaying & Hiding ==================================================
(defxosd xosd-show* : _xosd -> _status)
(provide xosd-show)
(define (xosd-show xosd) (unless (xosd-is-onscreen? xosd) (xosd-show* xosd)))
(defxosd xosd-hide* : _xosd -> _status)
(provide xosd-hide)
(define (xosd-hide xosd) (when (xosd-is-onscreen? xosd) (xosd-hide* xosd)))
(defxosd* xosd-set-timeout : _xosd _int -> _status)
(defxosd* xosd-wait-until-no-display : _xosd -> _status)
;; ===== Attributed ===========================================================
(define _xosd-pos (_enum '(top bottom middle)))
(define _xosd-align (_enum '(left center right)))
(defxosd* xosd-set-pos : _xosd _xosd-pos -> _status)
(defxosd* xosd-set-align : _xosd _xosd-align -> _status)
(defxosd* xosd-set-horizontal-offset : _xosd _int -> _status)
(defxosd* xosd-set-vertical-offset : _xosd _int -> _status)
(defxosd* xosd-set-shadow-offset : _xosd _int -> _status)
(defxosd* xosd-set-outline-offset : _xosd _int -> _status)
(defxosd* xosd-set-colour : _xosd _string -> _status)
(defxosd* xosd-set-shadow-colour : _xosd _string -> _status)
(defxosd* xosd-set-outline-colour : _xosd _string -> _status)
(defxosd* xosd-set-font : _xosd _string -> _status)
(defxosd* xosd-get-colour :
_xosd (r : (_ptr o _int)) (g : (_ptr o _int)) (b : (_ptr o _int)) -> _status
-> (list r g b))
(defxosd* xosd-get-number-lines : _xosd -> _status)
;; ===== Content ==============================================================
(define _xosd-command (_enum '(percentage string printf slider)))
(define disp-int*
(get-ffi-obj "xosd_display" libxosd
(_fun _xosd _int _xosd-command _int -> _status)))
(define disp-string*
(get-ffi-obj "xosd_display" libxosd
(_fun _xosd _int _xosd-command _string -> _status)))
(provide xosd-display-percentage xosd-display-string xosd-display-slider)
;; xosd-obj percent [line-num] -> int
(define (xosd-display-percentage xosd percent . line)
(disp-int* xosd (if (pair? line) (car line) 0) 'percentage percent))
;; xosd-obj string [line-num] -> int
(define (xosd-display-string xosd str . line)
(disp-string* xosd (if (pair? line) (car line) 0) 'string str))
;; xosd-obj percent [line-num] -> int
(define (xosd-display-slider xosd int . line)
(disp-int* xosd (if (pair? line) (car line) 0) 'slider int))
(defxosd* xosd-set-bar-length : _xosd _int -> _status)
(defxosd* xosd-scroll : _xosd _int -> _status)