mbutterick
/
words
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

more gui

Browse Source
master
Matthew Butterick 5 years ago
parent 64a404fa30
commit 6c307b6c6e
3 changed files with 106 additions and 26 deletions
Show Stats Download Patch File Download Diff File

116
words/app.rkt
Unescape Escape View File

@ -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)

6
words/command.rkt
Unescape Escape View File

@ -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 <)]

10
words/main.rkt
Unescape Escape View File

@ -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))

Write Preview
Loading…
Cancel
Save