f42356da3f
The main advantage of GTK+ 3 is better support for HiDPI displays. If GTK+ 3 libraries are not available or if the `PLT_GTK2` environment variable is defined, GTK+ 2 is used as before.
72 lines
1.9 KiB
Racket
72 lines
1.9 KiB
Racket
#lang racket/base
|
|
(require ffi/unsafe
|
|
ffi/unsafe/define
|
|
racket/class
|
|
"../../syntax.rkt"
|
|
"item.rkt"
|
|
"utils.rkt"
|
|
"types.rkt"
|
|
"window.rkt"
|
|
"const.rkt")
|
|
|
|
(provide
|
|
(protect-out gauge%))
|
|
|
|
;; ----------------------------------------
|
|
|
|
(define-gtk gtk_progress_bar_new (_fun _pointer -> _GtkWidget))
|
|
(define-gtk gtk_progress_bar_set_fraction (_fun _GtkWidget _double* -> _void))
|
|
(define-gtk gtk_orientable_set_orientation (_fun _GtkWidget _int -> _void)
|
|
#:make-fail make-not-available)
|
|
(define-gtk gtk_progress_bar_set_inverted (_fun _GtkWidget _gboolean -> _void)
|
|
#:make-fail make-not-available)
|
|
(define-gtk gtk_progress_bar_set_orientation (_fun _GtkWidget _int -> _void)
|
|
#:fail (lambda ()
|
|
(lambda (w o)
|
|
(gtk_orientable_set_orientation w GTK_ORIENTATION_VERTICAL)
|
|
(gtk_progress_bar_set_inverted w #t))))
|
|
|
|
(define GTK_PROGRESS_BOTTOM_TO_TOP 2)
|
|
(define GTK_ORIENTATION_VERTICAL 1)
|
|
|
|
(defclass gauge% item%
|
|
(init parent
|
|
label
|
|
rng
|
|
x y w h
|
|
style
|
|
font)
|
|
(inherit get-gtk set-auto-size)
|
|
|
|
(super-new [parent parent]
|
|
[gtk (as-gtk-allocation (gtk_progress_bar_new #f))]
|
|
[no-show? (memq 'deleted style)])
|
|
(define gtk (get-gtk))
|
|
|
|
(when (memq 'vertical style)
|
|
(gtk_progress_bar_set_orientation gtk GTK_PROGRESS_BOTTOM_TO_TOP))
|
|
|
|
(set-auto-size)
|
|
|
|
(define range rng)
|
|
(define value 0)
|
|
|
|
(define/private (reset)
|
|
(gtk_progress_bar_set_fraction gtk
|
|
(if (zero? range)
|
|
0.0
|
|
(/ value range))))
|
|
|
|
(define/public (get-range)
|
|
range)
|
|
(define/public (set-range r)
|
|
(set! range r)
|
|
(set! value (min value r))
|
|
(reset))
|
|
|
|
(define/public (set-value v)
|
|
(set! value v)
|
|
(reset))
|
|
(define/public (get-value)
|
|
value))
|