69 lines
2.9 KiB
Plaintext
69 lines
2.9 KiB
Plaintext
; Set up the app/window
|
|
; (gui-use-light-theme #t)
|
|
(define app (gui-create))
|
|
|
|
; Make a dummy var to reference in the callback
|
|
; for 'b', the submit button
|
|
(define contents "")
|
|
|
|
; Set up the widgets
|
|
(define l (widget-make-label "Slope" 0))
|
|
|
|
; Form widgets
|
|
(define l1 (widget-make-label "Text"))
|
|
(define e1 (widget-make-entry "Link Text" #f (lambda (s) (if (regex-match? ".+" s) #t "Invalid entry"))))
|
|
(define l2 (widget-make-label "URL"))
|
|
(define e2 (widget-make-entry "Link URL" #f (lambda (s) (if (regex-match? "[http|https|gemini|gopher|ftp]://.+\..+" s) #t "URL missing scheme"))))
|
|
(define img (widget-make-image "url" "http://slope.colorfield.space/slope-logo.png" "fit" 50 50))
|
|
(define b (widget-make-button "Submit"
|
|
(lambda ()
|
|
(define t (widget-get-text e1))
|
|
(define u (widget-get-text e2))
|
|
(widget-disable sel (not (widget-disable sel)))
|
|
(if (not (or (equal? "" u) (equal? "" t)))
|
|
(begin
|
|
(widget-set-text e1 "")
|
|
(widget-set-text e2 "")
|
|
(container-add-to contents (container "hbox" (widget-make-spacer) (widget-make-hyperlink t u)))))) 0 2))
|
|
|
|
; Checkbox to toggle the theme
|
|
(define cb (widget-make-checkbox "Light Theme"
|
|
(lambda (state)
|
|
(if state
|
|
(gui-use-light-theme app #t)
|
|
(gui-use-light-theme app #f)))))
|
|
|
|
(define tg (widget-make-text-grid "This is\n\tsome text"))
|
|
|
|
; A select that will trigger an info box and tell you about your selection
|
|
(define sel (widget-make-select ["Fun" "Functional" "Hackable" "Portable"] (lambda (choice) (dialog-info app "main" "Your Choice" (string-append "You chose: " choice))) 0))
|
|
|
|
; A markdown document rendered as a widget. Newlines are not recognized
|
|
(define md (widget-make-markdown "# Welcome to GUI\n\nThe slope gui is an experimental feature that can be _optionally_ compiled in with the interpreter.\n\nIt has some basic facilities, but is definitely **fun** to play with.\n\n- Windows\n- Widgets\n- Containers\n - Etc\n\n[Slope Git Org](https://git.rawtext.club/slope-lang) is a good place to check out." #t))
|
|
|
|
; Set up the container(s)
|
|
(set! contents
|
|
(container "vbox" img l md (widget-make-separator) cb sel (widget-make-separator) (container "form" l1 e1 l2 e2) b tg (widget-make-separator) (container "hbox" (widget-make-spacer) (widget-make-hyperlink "slope.colorfield.space" "https://slope.colorfield.space/"))))
|
|
|
|
; Add the containers to a scroll box
|
|
(define scroller (container-scroll contents))
|
|
|
|
; Configure the window
|
|
(gui-add-window app "main")
|
|
(window-set-content app "main" scroller)
|
|
(window-resize app "main" 400 550)
|
|
(window-center app "main")
|
|
(window-set-title app "main" "Slope GUI Demo")
|
|
|
|
;; Ctrl+Q to exit
|
|
(gui-add-shortcut app "main" (lambda () (exit 0)) "Q" "ctrl")
|
|
|
|
;; Print key presses that _arent_ in widgets with their own listeners
|
|
(gui-set-char-handlers app "main" (lambda (key) (display key " was pressed...\n")))
|
|
|
|
; Go time.
|
|
(window-show-and-run app "main")
|
|
|
|
|
|
|