From 99f78d37d7a40cfcf9aa2cdb384d1f4b0f25357e Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 15 Apr 2020 15:06:49 -0700 Subject: [PATCH] improve gui app --- words/app.rkt | 186 ++++++++++++++++++++++++++++++++++++------------- words/info.rkt | 4 +- words/main.rkt | 2 +- 3 files changed, 140 insertions(+), 52 deletions(-) diff --git a/words/app.rkt b/words/app.rkt index 0ba4c6e..233b1e0 100644 --- a/words/app.rkt +++ b/words/app.rkt @@ -1,11 +1,25 @@ #lang debug racket/gui (require words) + +(define the-fam + (for*/first ([preferred + '("Triplicate T4" "Menlo" "Consolas" "Andale Mono" "Courier")] + [mono-fam (in-list (get-face-list 'mono))] + #:when (equal? preferred mono-fam)) + preferred)) + +(define mono-font (make-font #:face the-fam #:size 16)) + (define window (new frame% [label "Words"] - [width 600] - [height 500] + [width 700] + [height 800] [x 100] - [y 100])) + [y 100] + [alignment '(left top)] + [spacing 12] + [border 6])) + (define current-optional (make-parameter "etaoinshrdluw")) (define current-omit (make-parameter #f)) @@ -16,20 +30,46 @@ (set! refresh-thread (let () (kill-thread refresh-thread) (thread (λ () (sleep 0.2) (refresh-wordbox)))))) -(for ([param (list current-optional current-omit current-mandatory current-combo)] - [str '("optional letters" "omitted letters" "mandatory letters" "mandatory combo")]) + +(define (update-text-field! tf param) + (param (match (send tf get-value) + [(? non-empty-string? str) str] + [_ #false])) + ;; put delay on refresh so that rapid typing + ;; doesn't trigger too many refreshes + (buffered-refresh)) + +(define (make-text-field param str [parent-panel #f]) (new text-field% - [parent window] + [parent (or parent-panel window)] [label str] + [font mono-font] + [horiz-margin (if parent-panel 0 12)] [init-value (or (param) "")] [stretchable-width #f] - [callback (λ (tf evt) - (param (match (send tf get-value) - [(? non-empty-string? str) str] - [_ #false])) - ;; put delay on refresh so that rapid typing - ;; doesn't trigger too many refreshes - (buffered-refresh))])) + [callback (λ (tf evt) (update-text-field! tf param))])) + +(let ([optional-letter-panel (new horizontal-panel% + [parent window] + [horiz-margin 6] + [alignment '(left top)] + [stretchable-height #false])]) + (define tf-optional + (make-text-field current-optional "optional letters" optional-letter-panel)) + (define ((tf-optional-button-callback str) button evt) + (send tf-optional set-value str) + (update-text-field! tf-optional current-optional)) + (for ([label-str '("clear" "a-z" "etaoinshrdluw")] + [str '("" "abcdefghijklmnopqrstuvwxyz" "etaoinshrdluw")]) + (new button% + [label label-str] + [parent optional-letter-panel] + [font mono-font] + [callback (tf-optional-button-callback str)]))) + +(for ([param (list current-omit current-mandatory current-combo)] + [str '("omitted letters" "mandatory letters" "mandatory combo")]) + (make-text-field param str)) (define current-min-size (make-parameter 3)) (define current-max-size (make-parameter 20)) @@ -39,44 +79,51 @@ [end-size (list (+ (current-min-size) 10) (current-max-size))] [label-str '("min length" "max length")] [selected-item (list 0 10)]) - (new radio-box% - [parent window] - [label label-str] - [style '(horizontal)] - [selection selected-item] - [choices (map number->string (range start-size (add1 end-size)))] - [callback (λ (rb evt) - (param (string->number (send rb get-item-label (send rb get-selection)))) - (refresh-wordbox))])) + (new radio-box% + [parent window] + [label label-str] + [font mono-font] + [horiz-margin 12] + [style '(horizontal)] + [selection selected-item] + [choices (map number->string (range start-size (add1 end-size)))] + [callback (λ (rb evt) + (param (string->number (send rb get-item-label (send rb get-selection)))) + (refresh-wordbox))])) (define current-proper-names-choice (make-parameter #f)) (define current-hide-plurals (make-parameter #f)) (let ([checkbox-panel (new horizontal-panel% [parent window] - [alignment '(center center)] + [alignment '(left top)] [stretchable-height #false])]) (for ([param (list current-proper-names-choice current-hide-plurals)] [msg '("show proper names" "hide plurals")]) - (new check-box% - [parent checkbox-panel] - [label msg] - [callback (λ (cb evt) - (param (send cb get-value)) - (refresh-wordbox))]))) + (new check-box% + [parent checkbox-panel] + [label msg] + [font mono-font] + [horiz-margin 6] + [callback (λ (cb evt) + (param (send cb get-value)) + (refresh-wordbox))]))) (define current-case-choice (make-parameter #f)) -(new radio-box% - [parent window] - [label #f] - [style '(horizontal)] - [choices '("default" "Title Case" "lowercase" "UPPERCASE")] - [callback (λ (rb evt) - (current-case-choice (match (send rb get-selection) - [1 'title] - [2 'lower] - [3 'upper] - [_ #false])) - (refresh-wordbox))]) +(define rb-casing + (new radio-box% + [parent window] + [label #f] + [font mono-font] + [horiz-margin 12] + [style '(horizontal)] + [choices '("default" "Title Case" "lowercase" "UPPERCASE")] + [callback (λ (rb evt) + (current-case-choice (match (send rb get-selection) + [1 'title] + [2 'lower] + [3 'upper] + [_ #false])) + (refresh-wordbox))])) (define (refresh-wordbox) (define ed (send wordbox get-editor)) @@ -99,21 +146,62 @@ (define current-word-count (make-parameter 50)) (let ([button-panel (new horizontal-panel% [parent window] - [alignment '(center center)] + [alignment '(left top)] [stretchable-height #false])]) (for ([count (in-list '(50 100 500 1000 all))]) - (define count-str (format "~a" count)) - (new button% [parent button-panel] - [label count-str] - [callback (λ (button evt) - (current-word-count (string->number count-str)) - (refresh-wordbox))]))) + (define count-str (format "~a" count)) + (new button% [parent button-panel] + [label count-str] + [font mono-font] + [callback (λ (button evt) + (current-word-count (string->number count-str)) + (refresh-wordbox))]))) (define wordbox (new text-field% [label #f] [style '(multiple)] [parent window] - [font (make-font #:face "Fira Mono OT" #:size 14)])) + [font mono-font])) + +(define (words-to-clipboard item evt) + (send the-clipboard set-clipboard-string (send wordbox get-value) (send evt get-time-stamp))) + +(define button-copy + (new button% [parent window] + [label "copy words"] + [font mono-font] + [stretchable-width #true] + [callback words-to-clipboard])) + + +(define menubar (new menu-bar% + [parent window])) + +(define menu-edit (new menu% + [parent menubar] + [label "Actions"])) + +(define (make-menu-item str char proc) + (new menu-item% + [parent menu-edit] + [label str] + [shortcut char] + [callback proc])) + +(define menu-item-copy (make-menu-item "Copy" #\C words-to-clipboard)) + +(define menu-item-refresh + (make-menu-item "Regenerate" #\R (λ (thing evt) (refresh-wordbox)))) + +(define menu-item-more-words + (make-menu-item "More" #\= (λ (thing evt) + (current-word-count (+ (current-word-count) 25)) + (refresh-wordbox)))) + +(define menu-item-fewer-words + (make-menu-item "Fewer" #\- (λ (thing evt) + (current-word-count (max (- (current-word-count) 25) 0)) + (refresh-wordbox)))) (refresh-wordbox) (send window show #t) diff --git a/words/info.rkt b/words/info.rkt index 1b4b5e2..5634898 100644 --- a/words/info.rkt +++ b/words/info.rkt @@ -3,5 +3,5 @@ (define post-install-collection "index.rkt") (define raco-commands '(("words" (submod words/command raco) "issue words command" #f))) -#;(define racket-launcher-names '("Words.app")) -#;(define racket-launcher-libraries '("app.rkt")) \ No newline at end of file +(define gracket-launcher-names '("Words.app")) +(define gracket-launcher-libraries '("app.rkt")) \ No newline at end of file diff --git a/words/main.rkt b/words/main.rkt index ae51aa5..b429852 100644 --- a/words/main.rkt +++ b/words/main.rkt @@ -58,7 +58,7 @@ (for/and ([wc (in-list (map char-downcase (charidx->chars word-charidx)))]) (letter-cs-charidx . contains-char? . wc)) (or (not combo) - (regexp-match combo word)) + (regexp-match (string-downcase combo) word)) ;; word does not contain forbidden characters (for/and ([fc (in-list forbidden-cs)]) (not (word-charidx . contains-char? . fc)))