more gui

words/app.rkt

@@ -1,35 +1,113 @@
-#lang racket/gui
+#lang debug racket/gui
 (require words)
 
-(define frame (new frame% [label "Words"]
+(define window (new frame% [label "Words"]
-                   [width 500]
+                    [width 600]
-                   [height 500]
+                    [height 500]
-                   [x 100]
+                    [x 100]
-                   [y 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])
+(define current-word-count (make-parameter 50))
-  (fill-wordbox word-count))
 
-(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)])
+  (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 procedure for a button click:
+         [callback (λ (button evt)
-            [callback (make-wordbox-callback (string->number count-str))])))
+                     (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)
 

words/command.rkt

@@ -79,8 +79,10 @@
                             #:max max-size
                             #:hide-plurals hide-plurals
                             #:proper-names proper-names
-                            #:all-caps uppercase
+                            #:case (cond
-                            #:initial-caps title-case))
+                                     [uppercase 'upper]
+                                     [title-case 'title]
+                                     [else #false])))
   (define-values (sort-key sort-cmp)
     (match sort-style
       ["kernscore" (values kernscore <)]

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]
+                    #:case [casing #f])
-                    #:initial-caps [initial-caps? #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
+  (define caser (case casing
-                  [all-caps? string-upcase]
+                  [(up upcase upper uppercase) string-upcase]
-                  [initial-caps? string-titlecase]
+                  [(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))