
Support GUI scaling in much the same way as on Windows, where the OS setting ("org.gnome.desktop.interface.scaling-factor" times "...text-scaling-factor") determines the scale that is used for both graphics and GUI sizing. As I understand it, a complete solution requires porting to Gtk3. With Gtk2, the graphical part of a widget doesn't scale. Text and image labels should scale correctly, though.
132 lines
4.7 KiB
Racket
132 lines
4.7 KiB
Racket
#lang racket/base
|
|
(require racket/class
|
|
ffi/unsafe
|
|
"../../syntax.rkt"
|
|
"item.rkt"
|
|
(except-in "utils.rkt" _GSList)
|
|
"types.rkt"
|
|
"widget.rkt"
|
|
"window.rkt"
|
|
"pixbuf.rkt"
|
|
"message.rkt"
|
|
"../common/event.rkt"
|
|
"../../lock.rkt")
|
|
|
|
(provide
|
|
(protect-out radio-box%))
|
|
|
|
;; ----------------------------------------
|
|
|
|
(define _GSList (_cpointer/null 'GSList))
|
|
|
|
(define-gtk gtk_radio_button_new_with_mnemonic (_fun _GSList _string -> _GtkWidget))
|
|
(define-gtk gtk_radio_button_new (_fun _GSList -> _GtkWidget))
|
|
(define-gtk gtk_radio_button_get_group (_fun _GtkWidget -> _GSList))
|
|
(define-gtk gtk_radio_button_set_group (_fun _GtkWidget _GSList -> _void))
|
|
(define-gtk gtk_toggle_button_set_active (_fun _GtkWidget _gboolean -> _void))
|
|
(define-gtk gtk_toggle_button_get_active (_fun _GtkWidget -> _gboolean))
|
|
(define-gtk gtk_widget_is_focus (_fun _GtkWidget -> _gboolean))
|
|
(define-gtk gtk_bin_get_child (_fun _GtkWidget -> _GtkWidget))
|
|
|
|
(define-signal-handler connect-clicked "clicked"
|
|
(_fun _GtkWidget -> _void)
|
|
(lambda (gtk)
|
|
(let ([wx (gtk->wx gtk)])
|
|
(when wx
|
|
(send wx queue-clicked)))))
|
|
|
|
(defclass radio-box% item%
|
|
(init parent cb label
|
|
x y w h
|
|
labels
|
|
val
|
|
style
|
|
font)
|
|
(inherit set-auto-size
|
|
on-set-focus)
|
|
|
|
(define gtk (as-gtk-allocation
|
|
(if (memq 'horizontal style)
|
|
(gtk_hbox_new #f 0)
|
|
(gtk_vbox_new #f 0))))
|
|
(define radio-gtks (for/list ([lbl (in-list labels)])
|
|
(atomically
|
|
(let ([radio-gtk (cond
|
|
[(string? lbl)
|
|
(gtk_radio_button_new_with_mnemonic #f (mnemonic-string lbl))]
|
|
[else
|
|
(let ([pixbuf (bitmap->pixbuf lbl (->screen 1.0))])
|
|
(let ([radio-gtk (gtk_radio_button_new #f)]
|
|
[image-gtk (gtk_image_new_from_pixbuf pixbuf)])
|
|
(release-pixbuf pixbuf)
|
|
(gtk_container_add radio-gtk image-gtk)
|
|
(gtk_widget_show image-gtk)
|
|
radio-gtk))])])
|
|
(gtk_box_pack_start gtk radio-gtk #t #t 0)
|
|
(install-control-font (gtk_bin_get_child radio-gtk) font)
|
|
(gtk_widget_show radio-gtk)
|
|
radio-gtk))))
|
|
(for ([radio-gtk (in-list (cdr radio-gtks))])
|
|
(let ([g (gtk_radio_button_get_group (car radio-gtks))])
|
|
(gtk_radio_button_set_group radio-gtk g)))
|
|
|
|
(define dummy-gtk #f)
|
|
|
|
(super-new [parent parent]
|
|
[gtk gtk]
|
|
[extra-gtks radio-gtks]
|
|
[callback cb]
|
|
[no-show? (memq 'deleted style)])
|
|
|
|
(set-auto-size)
|
|
(for ([radio-gtk (in-list radio-gtks)])
|
|
(connect-clicked radio-gtk)
|
|
(connect-key-and-mouse radio-gtk)
|
|
(connect-focus radio-gtk))
|
|
|
|
(define callback cb)
|
|
(define/public (clicked)
|
|
(callback this (new control-event%
|
|
[event-type 'radio-box]
|
|
[time-stamp (current-milliseconds)])))
|
|
(define no-clicked? #f)
|
|
(define/public (queue-clicked)
|
|
(unless no-clicked?
|
|
(queue-window-event this (lambda () (clicked)))))
|
|
|
|
(define/public (button-focus i)
|
|
(if (= i -1)
|
|
(or (for/or ([radio-gtk (in-list radio-gtks)]
|
|
[i (in-naturals)])
|
|
(and (gtk_widget_is_focus radio-gtk)
|
|
i))
|
|
0)
|
|
(gtk_widget_grab_focus (list-ref radio-gtks i))))
|
|
(define/override (set-focus)
|
|
(button-focus (max 0 (get-selection))))
|
|
(define/public (set-selection i)
|
|
(atomically
|
|
(set! no-clicked? #t)
|
|
(if (= i -1)
|
|
(when (pair? radio-gtks)
|
|
(unless dummy-gtk
|
|
(set! dummy-gtk (as-gtk-allocation
|
|
(gtk_radio_button_new
|
|
(gtk_radio_button_get_group (car radio-gtks))))))
|
|
(gtk_toggle_button_set_active dummy-gtk #t))
|
|
(gtk_toggle_button_set_active (list-ref radio-gtks i) #t))
|
|
(set! no-clicked? #f)))
|
|
|
|
(define/public (get-selection)
|
|
(or (for/or ([radio-gtk (in-list radio-gtks)]
|
|
[i (in-naturals)])
|
|
(and (gtk_toggle_button_get_active radio-gtk)
|
|
i))
|
|
-1))
|
|
|
|
(define/public (enable-button i on?)
|
|
(gtk_widget_set_sensitive (list-ref radio-gtks i) on?))
|
|
|
|
(define count (length labels))
|
|
(define/public (number) count))
|