105 lines
3.8 KiB
Racket
105 lines
3.8 KiB
Racket
#lang scheme/base
|
|
|
|
(require mzlib/foreign) (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)
|