diff --git a/words/app.rkt b/words/app.rkt index fa5af70..231b178 100644 --- a/words/app.rkt +++ b/words/app.rkt @@ -1,35 +1,113 @@ -#lang racket/gui +#lang debug racket/gui (require words) -(define frame (new frame% [label "Words"] - [width 500] - [height 500] - [x 100] - [y 100])) +(define window (new frame% [label "Words"] + [width 600] + [height 500] + [x 100] + [y 100])) -(define (fill-wordbox [word-count 100]) +(define current-optional (make-parameter "etaoinshrdluw")) +(define current-omit (make-parameter #f)) +(define current-mandatory (make-parameter #f)) +(define current-combo (make-parameter #f)) +(for ([param (list current-optional current-omit current-mandatory current-combo)] + [str '("optional letters" "omitted letters" "mandatory letters" "mandatory combo")]) + (new text-field% + [parent window] + [label str] + [init-value (or (param) "")] + [stretchable-width #f] + [callback (λ (tf evt) + (param (match (send tf get-value) + [(? non-empty-string? str) str] + [_ #false])) + (refresh-wordbox))])) + +(define current-min-size (make-parameter 3)) +(define current-max-size (make-parameter 20)) + +(for ([param (list current-min-size current-max-size)] + [start-size (list (current-min-size) (- (current-max-size) 10))] + [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))])) + +(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)] + [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))]))) + +(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 (refresh-wordbox) (define ed (send wordbox get-editor)) (send ed erase) - (send ed insert (string-join (make-words #:count word-count) " " #:after-last " "))) + (send ed insert + (string-join + (match (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)) + [(list words ..1) words] + [_ (list "[no matching words]")]) " "))) -(define ((make-wordbox-callback word-count) [button #f] [event #f]) - (fill-wordbox word-count)) +(define current-word-count (make-parameter 50)) -(let ([button-panel (new horizontal-panel% [parent frame] +(let ([button-panel (new horizontal-panel% [parent window] [alignment '(center center)] [stretchable-height #false])]) - (for ([count '(100 250 500 1000 all)]) - (define count-str (format "~a" count)) - (new button% [parent button-panel] - [label count-str] - ; Callback procedure for a button click: - [callback (make-wordbox-callback (string->number count-str))]))) + (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 wordbox (new text-field% [label #f] [style '(multiple)] - [parent frame] + [parent window] [font (make-font #:face "Fira Mono OT" #:size 14)])) -(send frame show #t) +(refresh-wordbox) +(send window show #t) diff --git a/words/command.rkt b/words/command.rkt index 7420573..fec0cb2 100755 --- a/words/command.rkt +++ b/words/command.rkt @@ -79,8 +79,10 @@ #:max max-size #:hide-plurals hide-plurals #:proper-names proper-names - #:all-caps uppercase - #:initial-caps title-case)) + #:case (cond + [uppercase 'upper] + [title-case 'title] + [else #false]))) (define-values (sort-key sort-cmp) (match sort-style ["kernscore" (values kernscore <)] diff --git a/words/main.rkt b/words/main.rkt index e821272..ae51aa5 100644 --- a/words/main.rkt +++ b/words/main.rkt @@ -12,8 +12,7 @@ #:hide-plurals [hide-plurals? #t] #:proper-names [proper-names? #f] #:count [count 10] - #:all-caps [all-caps? #f] - #:initial-caps [initial-caps? #f]) + #:case [casing #f]) (define letters (or letters-arg "abcdefghijklmnopqrstuvwxyz")) (define mandatory-cs (if (or mandatory combo) @@ -34,9 +33,10 @@ null) mandatory-cs) char=?)))) - (define caser (cond - [all-caps? string-upcase] - [initial-caps? string-titlecase] + (define caser (case casing + [(up upcase upper uppercase) string-upcase] + [(title titlecase) string-titlecase] + [(down downcase lower lowercase) string-downcase] [else values])) (define min-length (or min-length-arg 0)) (define max-length (or max-length-arg +inf.0))