mbutterick
/
words
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

add menu shortcuts

Browse Source
master
Matthew Butterick 5 years ago
parent 207b1c2225
commit c450d45984
1 changed files with 58 additions and 47 deletions
Show Stats Download Patch File Download Diff File

105
words/app.rkt
Unescape Escape View File

@ -6,7 +6,7 @@
'("Triplicate T4" "Menlo" "Consolas" "Andale Mono" "Courier")] '("Triplicate T4" "Menlo" "Consolas" "Andale Mono" "Courier")]
[mono-fam (in-list (get-face-list 'mono))] [mono-fam (in-list (get-face-list 'mono))]
#:when (equal? preferred mono-fam)) #:when (equal? preferred mono-fam))
preferred)) preferred))
(define app-font-size 16) (define app-font-size 16)
(define app-font (make-font #:face (send normal-control-font get-face) #:size app-font-size)) (define app-font (make-font #:face (send normal-control-font get-face) #:size app-font-size))
@ -50,27 +50,30 @@
[stretchable-width #f] [stretchable-width #f]
[callback (λ (tf evt) (update-text-field! tf param))])) [callback (λ (tf evt) (update-text-field! tf param))]))
(let ([optional-letter-panel (new horizontal-panel% (define optional-letter-panel (new horizontal-panel%
[parent window] [parent window]
[horiz-margin 6] [horiz-margin 6]
[alignment '(left top)] [alignment '(left top)]
[stretchable-height #false])]) [stretchable-height #false]))
(define tf-optional (define tf-optional
(make-text-field current-optional "optional letters" optional-letter-panel)) (make-text-field current-optional "optional letters" optional-letter-panel))
(define ((tf-optional-button-callback str) button evt)
(send tf-optional set-value str) (define ((tf-optional-button-callback str) button evt)
(update-text-field! tf-optional current-optional)) (send tf-optional set-value str)
(for ([label-str '("clear" "a-z" "etaoinshrdluw")] (update-text-field! tf-optional current-optional))
[str '("" "abcdefghijklmnopqrstuvwxyz" "etaoinshrdluw")])
(new button% (match-define (list button-clear button-az button-common)
[label label-str] (for/list ([label-str '("clear" "a-z" "etaoinshrdluw")]
[parent optional-letter-panel] [str '("" "abcdefghijklmnopqrstuvwxyz" "etaoinshrdluw")])
[font app-font] (new button%
[callback (tf-optional-button-callback str)]))) [label label-str]
[parent optional-letter-panel]
[font app-font]
[callback (tf-optional-button-callback str)])))
(for ([param (list current-omit current-mandatory current-combo)] (for ([param (list current-omit current-mandatory current-combo)]
[str '("omitted letters" "mandatory letters" "mandatory combo")]) [str '("omitted letters" "mandatory letters" "mandatory combo")])
(make-text-field param str)) (make-text-field param str))
(define current-min-size (make-parameter 3)) (define current-min-size (make-parameter 3))
(define current-max-size (make-parameter 24)) (define current-max-size (make-parameter 24))
@ -84,17 +87,17 @@
(for ([param (list current-min-size current-max-size)] (for ([param (list current-min-size current-max-size)]
[label-str '("word length from" "to")]) [label-str '("word length from" "to")])
(new slider% (new slider%
[parent length-panel] [parent length-panel]
[label label-str] [label label-str]
[font app-font] [font app-font]
[min-value (current-min-size)] [min-value (current-min-size)]
[max-value (current-max-size)] [max-value (current-max-size)]
[init-value (param)] [init-value (param)]
[stretchable-width #t] [stretchable-width #t]
[callback (λ (cb evt) [callback (λ (cb evt)
(param (send cb get-value)) (param (send cb get-value))
(buffered-refresh))])) (buffered-refresh))]))
(define current-proper-names-choice (make-parameter #f)) (define current-proper-names-choice (make-parameter #f))
(define current-hide-plurals (make-parameter #f)) (define current-hide-plurals (make-parameter #f))
@ -104,14 +107,14 @@
[stretchable-height #false])]) [stretchable-height #false])])
(for ([param (list current-proper-names-choice current-hide-plurals)] (for ([param (list current-proper-names-choice current-hide-plurals)]
[msg '("show proper names" "hide plurals")]) [msg '("show proper names" "hide plurals")])
(new check-box% (new check-box%
[parent checkbox-panel] [parent checkbox-panel]
[label msg] [label msg]
[font app-font] [font app-font]
[horiz-margin 6] [horiz-margin 6]
[callback (λ (cb evt) [callback (λ (cb evt)
(param (send cb get-value)) (param (send cb get-value))
(refresh-wordbox))]))) (refresh-wordbox))])))
(define current-case-choice (make-parameter #f)) (define current-case-choice (make-parameter #f))
(define rb-casing (define rb-casing
@ -156,13 +159,13 @@
[alignment '(left top)] [alignment '(left top)]
[stretchable-height #false])]) [stretchable-height #false])])
(for ([count (in-list '(50 100 200 400 800 1600))]) (for ([count (in-list '(50 100 200 400 800 1600))])
(define count-str (format "~a" count)) (define count-str (format "~a" count))
(new button% [parent button-panel] (new button% [parent button-panel]
[label count-str] [label count-str]
[font app-font] [font app-font]
[callback (λ (button evt) [callback (λ (button evt)
(current-word-count (string->number count-str)) (current-word-count (string->number count-str))
(refresh-wordbox))]))) (refresh-wordbox))])))
(define wordbox (new text-field% (define wordbox (new text-field%
[label #f] [label #f]
@ -212,15 +215,23 @@
(current-word-count new-count)) (current-word-count new-count))
(define menu-item-more-words (define menu-item-more-words
(make-menu-item "More" #\= (λ (thing evt) (make-menu-item "More words" #\= (λ (thing evt)
(change-word-count 25) (change-word-count 25)
(refresh-wordbox)))) (refresh-wordbox))))
(define menu-item-fewer-words (define menu-item-fewer-words
(make-menu-item "Fewer" #\- (λ (thing evt) (make-menu-item "Fewer words" #\- (λ (thing evt)
(change-word-count -25) (change-word-count -25)
(refresh-wordbox)))) (refresh-wordbox))))
; (list button-clear button-az button-common)
(define menu-item-clear
(make-menu-item "Clear letters" #\1 (λ (thing evt) (send button-clear command evt))))
(define menu-item-az
(make-menu-item "Use a-z" #\2 (λ (thing evt) (send button-az command evt))))
(define menu-item-common
(make-menu-item "Use etaoin" #\3 (λ (thing evt) (send button-common command evt))))
(refresh-wordbox) (refresh-wordbox)
(send window show #t) (send window show #t)

Write Preview
Loading…
Cancel
Save