improve gui app

words/app.rkt

@@ -1,11 +1,25 @@
 #lang debug racket/gui
 (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"]
-                    [width 600]
-                    [height 500]
+                    [width 700]
+                    [height 800]
                     [x 100]
-                    [y 100]))
+                    [y 100]
+                    [alignment '(left top)]
+                    [spacing 12]
+                    [border 6]))
+
 
 (define current-optional (make-parameter "etaoinshrdluw"))
 (define current-omit (make-parameter #f))
@@ -16,20 +30,46 @@
   (set! refresh-thread (let ()
                          (kill-thread refresh-thread)
                          (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%	 	 
-       [parent window]
+       [parent (or parent-panel window)]
        [label str]
+       [font mono-font]
+       [horiz-margin (if parent-panel 0 12)]
        [init-value (or (param) "")]
        [stretchable-width #f]
-       [callback (λ (tf evt)
-                   (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))]))
+       [callback (λ (tf evt) (update-text-field! tf param))]))
+
+(let ([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))
+  (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-max-size (make-parameter 20))
@@ -39,44 +79,51 @@
       [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))]))
+     (new radio-box%
+          [parent window]
+          [label label-str]
+          [font mono-font]
+          [horiz-margin 12]
+          [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)]
+                           [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]
-         [callback (λ (cb evt)
-                     (param (send cb get-value))
-                     (refresh-wordbox))])))
+       (new check-box%
+            [parent checkbox-panel]
+            [label msg]
+            [font mono-font]
+            [horiz-margin 6]
+            [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 rb-casing
+  (new radio-box%
+       [parent window]
+       [label #f]
+       [font mono-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))
@@ -99,21 +146,62 @@
 (define current-word-count (make-parameter 50))
 
 (let ([button-panel (new horizontal-panel% [parent window]
-                         [alignment '(center center)]
+                         [alignment '(left top)]
                          [stretchable-height #false])])
   (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 count-str (format "~a" count))
+       (new button% [parent button-panel]
+            [label count-str]
+            [font mono-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 "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)
 (send window show #t)

words/info.rkt

@@ -3,5 +3,5 @@
 (define post-install-collection "index.rkt")
 (define raco-commands '(("words" (submod words/command raco) "issue words command" #f)))
 
-#;(define racket-launcher-names '("Words.app"))
-#;(define racket-launcher-libraries '("app.rkt"))
+(define gracket-launcher-names '("Words.app"))
+(define gracket-launcher-libraries '("app.rkt"))

words/main.rkt

@@ -58,7 +58,7 @@
                       (for/and ([wc (in-list (map char-downcase (charidx->chars word-charidx)))])
                                (letter-cs-charidx . contains-char? . wc))
                       (or (not combo)
-                          (regexp-match combo word))
+                          (regexp-match (string-downcase combo) word))
                       ;; word does not contain forbidden characters
                       (for/and ([fc (in-list forbidden-cs)])
                         (not (word-charidx . contains-char? . fc)))