|
|
@ -1,11 +1,25 @@
|
|
|
|
#lang debug racket/gui
|
|
|
|
#lang debug racket/gui
|
|
|
|
(require words)
|
|
|
|
(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"]
|
|
|
|
(define window (new frame% [label "Words"]
|
|
|
|
[width 600]
|
|
|
|
[width 700]
|
|
|
|
[height 500]
|
|
|
|
[height 800]
|
|
|
|
[x 100]
|
|
|
|
[x 100]
|
|
|
|
[y 100]))
|
|
|
|
[y 100]
|
|
|
|
|
|
|
|
[alignment '(left top)]
|
|
|
|
|
|
|
|
[spacing 12]
|
|
|
|
|
|
|
|
[border 6]))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(define current-optional (make-parameter "etaoinshrdluw"))
|
|
|
|
(define current-optional (make-parameter "etaoinshrdluw"))
|
|
|
|
(define current-omit (make-parameter #f))
|
|
|
|
(define current-omit (make-parameter #f))
|
|
|
@ -16,20 +30,46 @@
|
|
|
|
(set! refresh-thread (let ()
|
|
|
|
(set! refresh-thread (let ()
|
|
|
|
(kill-thread refresh-thread)
|
|
|
|
(kill-thread refresh-thread)
|
|
|
|
(thread (λ () (sleep 0.2) (refresh-wordbox))))))
|
|
|
|
(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%
|
|
|
|
(new text-field%
|
|
|
|
[parent window]
|
|
|
|
[parent (or parent-panel window)]
|
|
|
|
[label str]
|
|
|
|
[label str]
|
|
|
|
|
|
|
|
[font mono-font]
|
|
|
|
|
|
|
|
[horiz-margin (if parent-panel 0 12)]
|
|
|
|
[init-value (or (param) "")]
|
|
|
|
[init-value (or (param) "")]
|
|
|
|
[stretchable-width #f]
|
|
|
|
[stretchable-width #f]
|
|
|
|
[callback (λ (tf evt)
|
|
|
|
[callback (λ (tf evt) (update-text-field! tf param))]))
|
|
|
|
(param (match (send tf get-value)
|
|
|
|
|
|
|
|
[(? non-empty-string? str) str]
|
|
|
|
(let ([optional-letter-panel (new horizontal-panel%
|
|
|
|
[_ #false]))
|
|
|
|
[parent window]
|
|
|
|
;; put delay on refresh so that rapid typing
|
|
|
|
[horiz-margin 6]
|
|
|
|
;; doesn't trigger too many refreshes
|
|
|
|
[alignment '(left top)]
|
|
|
|
(buffered-refresh))]))
|
|
|
|
[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-min-size (make-parameter 3))
|
|
|
|
(define current-max-size (make-parameter 20))
|
|
|
|
(define current-max-size (make-parameter 20))
|
|
|
@ -39,44 +79,51 @@
|
|
|
|
[end-size (list (+ (current-min-size) 10) (current-max-size))]
|
|
|
|
[end-size (list (+ (current-min-size) 10) (current-max-size))]
|
|
|
|
[label-str '("min length" "max length")]
|
|
|
|
[label-str '("min length" "max length")]
|
|
|
|
[selected-item (list 0 10)])
|
|
|
|
[selected-item (list 0 10)])
|
|
|
|
(new radio-box%
|
|
|
|
(new radio-box%
|
|
|
|
[parent window]
|
|
|
|
[parent window]
|
|
|
|
[label label-str]
|
|
|
|
[label label-str]
|
|
|
|
[style '(horizontal)]
|
|
|
|
[font mono-font]
|
|
|
|
[selection selected-item]
|
|
|
|
[horiz-margin 12]
|
|
|
|
[choices (map number->string (range start-size (add1 end-size)))]
|
|
|
|
[style '(horizontal)]
|
|
|
|
[callback (λ (rb evt)
|
|
|
|
[selection selected-item]
|
|
|
|
(param (string->number (send rb get-item-label (send rb get-selection))))
|
|
|
|
[choices (map number->string (range start-size (add1 end-size)))]
|
|
|
|
(refresh-wordbox))]))
|
|
|
|
[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-proper-names-choice (make-parameter #f))
|
|
|
|
(define current-hide-plurals (make-parameter #f))
|
|
|
|
(define current-hide-plurals (make-parameter #f))
|
|
|
|
(let ([checkbox-panel (new horizontal-panel%
|
|
|
|
(let ([checkbox-panel (new horizontal-panel%
|
|
|
|
[parent window]
|
|
|
|
[parent window]
|
|
|
|
[alignment '(center center)]
|
|
|
|
[alignment '(left top)]
|
|
|
|
[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]
|
|
|
|
[callback (λ (cb evt)
|
|
|
|
[font mono-font]
|
|
|
|
(param (send cb get-value))
|
|
|
|
[horiz-margin 6]
|
|
|
|
(refresh-wordbox))])))
|
|
|
|
[callback (λ (cb evt)
|
|
|
|
|
|
|
|
(param (send cb get-value))
|
|
|
|
|
|
|
|
(refresh-wordbox))])))
|
|
|
|
|
|
|
|
|
|
|
|
(define current-case-choice (make-parameter #f))
|
|
|
|
(define current-case-choice (make-parameter #f))
|
|
|
|
(new radio-box%
|
|
|
|
(define rb-casing
|
|
|
|
[parent window]
|
|
|
|
(new radio-box%
|
|
|
|
[label #f]
|
|
|
|
[parent window]
|
|
|
|
[style '(horizontal)]
|
|
|
|
[label #f]
|
|
|
|
[choices '("default" "Title Case" "lowercase" "UPPERCASE")]
|
|
|
|
[font mono-font]
|
|
|
|
[callback (λ (rb evt)
|
|
|
|
[horiz-margin 12]
|
|
|
|
(current-case-choice (match (send rb get-selection)
|
|
|
|
[style '(horizontal)]
|
|
|
|
[1 'title]
|
|
|
|
[choices '("default" "Title Case" "lowercase" "UPPERCASE")]
|
|
|
|
[2 'lower]
|
|
|
|
[callback (λ (rb evt)
|
|
|
|
[3 'upper]
|
|
|
|
(current-case-choice (match (send rb get-selection)
|
|
|
|
[_ #false]))
|
|
|
|
[1 'title]
|
|
|
|
(refresh-wordbox))])
|
|
|
|
[2 'lower]
|
|
|
|
|
|
|
|
[3 'upper]
|
|
|
|
|
|
|
|
[_ #false]))
|
|
|
|
|
|
|
|
(refresh-wordbox))]))
|
|
|
|
|
|
|
|
|
|
|
|
(define (refresh-wordbox)
|
|
|
|
(define (refresh-wordbox)
|
|
|
|
(define ed (send wordbox get-editor))
|
|
|
|
(define ed (send wordbox get-editor))
|
|
|
@ -99,21 +146,62 @@
|
|
|
|
(define current-word-count (make-parameter 50))
|
|
|
|
(define current-word-count (make-parameter 50))
|
|
|
|
|
|
|
|
|
|
|
|
(let ([button-panel (new horizontal-panel% [parent window]
|
|
|
|
(let ([button-panel (new horizontal-panel% [parent window]
|
|
|
|
[alignment '(center center)]
|
|
|
|
[alignment '(left top)]
|
|
|
|
[stretchable-height #false])])
|
|
|
|
[stretchable-height #false])])
|
|
|
|
(for ([count (in-list '(50 100 500 1000 all))])
|
|
|
|
(for ([count (in-list '(50 100 500 1000 all))])
|
|
|
|
(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]
|
|
|
|
[callback (λ (button evt)
|
|
|
|
[font mono-font]
|
|
|
|
(current-word-count (string->number count-str))
|
|
|
|
[callback (λ (button evt)
|
|
|
|
(refresh-wordbox))])))
|
|
|
|
(current-word-count (string->number count-str))
|
|
|
|
|
|
|
|
(refresh-wordbox))])))
|
|
|
|
|
|
|
|
|
|
|
|
(define wordbox (new text-field%
|
|
|
|
(define wordbox (new text-field%
|
|
|
|
[label #f]
|
|
|
|
[label #f]
|
|
|
|
[style '(multiple)]
|
|
|
|
[style '(multiple)]
|
|
|
|
[parent window]
|
|
|
|
[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)
|
|
|
|
(refresh-wordbox)
|
|
|
|
(send window show #t)
|
|
|
|
(send window show #t)
|
|
|
|