|
|
#lang debug racket/gui
|
|
|
(require words)
|
|
|
|
|
|
(define app-mono-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 app-font-size 16)
|
|
|
(define app-font (make-font #:face (send normal-control-font get-face) #:size app-font-size))
|
|
|
|
|
|
(define window (new frame% [label "Words"]
|
|
|
[width 700]
|
|
|
[height 700]
|
|
|
[x 40]
|
|
|
[y 40]
|
|
|
[alignment '(left top)]
|
|
|
[spacing 6]
|
|
|
[border 6]))
|
|
|
|
|
|
|
|
|
(define current-optional (make-parameter "etaoinshrdluw"))
|
|
|
(define current-omit (make-parameter #f))
|
|
|
(define current-mandatory (make-parameter #f))
|
|
|
(define current-combo (make-parameter #f))
|
|
|
(define refresh-thread (thread void))
|
|
|
(define (buffered-refresh)
|
|
|
(set! refresh-thread (let ()
|
|
|
(kill-thread refresh-thread)
|
|
|
(thread (λ () (sleep 0.2) (refresh-wordbox))))))
|
|
|
|
|
|
(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 (or parent-panel window)]
|
|
|
[label str]
|
|
|
[font app-font]
|
|
|
[horiz-margin (if parent-panel 0 12)]
|
|
|
[init-value (or (param) "")]
|
|
|
[min-width 330]
|
|
|
[stretchable-width #f]
|
|
|
[callback (λ (tf evt) (update-text-field! tf param))]))
|
|
|
|
|
|
(define 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))
|
|
|
|
|
|
(match-define (list button-clear button-az button-common)
|
|
|
(for/list ([label-str '("clear" "a-z" "etaoinshrdluw")]
|
|
|
[str '("" "abcdefghijklmnopqrstuvwxyz" "etaoinshrdluw")])
|
|
|
(new button%
|
|
|
[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)]
|
|
|
[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 24))
|
|
|
|
|
|
(define length-panel (new horizontal-panel%
|
|
|
[parent window]
|
|
|
[horiz-margin 6]
|
|
|
[alignment '(left top)]
|
|
|
[stretchable-width #true]
|
|
|
[stretchable-height #false]))
|
|
|
|
|
|
(for ([param (list current-min-size current-max-size)]
|
|
|
[label-str '("word length from" "to")])
|
|
|
(new slider%
|
|
|
[parent length-panel]
|
|
|
[label label-str]
|
|
|
[font app-font]
|
|
|
[min-value (current-min-size)]
|
|
|
[max-value (current-max-size)]
|
|
|
[init-value (param)]
|
|
|
[stretchable-width #t]
|
|
|
[callback (λ (cb evt)
|
|
|
(param (send cb get-value))
|
|
|
(buffered-refresh))]))
|
|
|
|
|
|
(define current-proper-names-choice (make-parameter #f))
|
|
|
(define current-hide-plurals (make-parameter #f))
|
|
|
(let ([checkbox-panel (new horizontal-panel%
|
|
|
[parent window]
|
|
|
[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]
|
|
|
[font app-font]
|
|
|
[horiz-margin 6]
|
|
|
[callback (λ (cb evt)
|
|
|
(param (send cb get-value))
|
|
|
(refresh-wordbox))])))
|
|
|
|
|
|
(define current-case-choice (make-parameter #f))
|
|
|
(define rb-casing
|
|
|
(new radio-box%
|
|
|
[parent window]
|
|
|
[label "casing "]
|
|
|
[font app-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))
|
|
|
(send ed erase)
|
|
|
(define wordlist (make-words #:count (current-word-count)
|
|
|
#:letters (current-optional)
|
|
|
#:omit (current-omit)
|
|
|
#:mandatory (current-mandatory)
|
|
|
#:combo (current-combo)
|
|
|
#:case (current-case-choice)
|
|
|
#:min (current-min-size)
|
|
|
#:max (current-max-size)
|
|
|
#:proper-names (current-proper-names-choice)
|
|
|
#:hide-plurals (current-hide-plurals)))
|
|
|
(send ed insert
|
|
|
(string-join
|
|
|
(match wordlist
|
|
|
[(list words ..1) words]
|
|
|
[_ (list "[no matching words]")]) " "))
|
|
|
(update-copy-button-label (length wordlist)))
|
|
|
|
|
|
(define current-word-count (make-parameter 50))
|
|
|
|
|
|
(let ([button-panel (new horizontal-panel% [parent window]
|
|
|
[alignment '(left top)]
|
|
|
[stretchable-height #false])])
|
|
|
(for ([count (in-list '(50 100 200 400 800 1600))])
|
|
|
(define count-str (format "~a" count))
|
|
|
(new button% [parent button-panel]
|
|
|
[label count-str]
|
|
|
[font app-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 app-mono-fam #:size app-font-size)]))
|
|
|
|
|
|
(let ([ed (send wordbox get-editor)])
|
|
|
(send ed set-line-spacing (* app-font-size 0.4))
|
|
|
(send ed set-padding 6 3 6 3))
|
|
|
|
|
|
(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 app-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 (update-copy-button-label count)
|
|
|
(send button-copy set-label (format "copy ~a word~a" count (if (= 1 count) "" "s"))))
|
|
|
|
|
|
(define (change-word-count amt)
|
|
|
(define new-count (max (+ (current-word-count) amt) 0))
|
|
|
(current-word-count new-count))
|
|
|
|
|
|
(define menu-item-more-words
|
|
|
(make-menu-item "More words" #\= (λ (thing evt)
|
|
|
(change-word-count 25)
|
|
|
(refresh-wordbox))))
|
|
|
|
|
|
(define menu-item-fewer-words
|
|
|
(make-menu-item "Fewer words" #\- (λ (thing evt)
|
|
|
(change-word-count -25)
|
|
|
(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)
|
|
|
(send window show #t)
|
|
|
|