formular,conscript: add make-radios-with-other

congame-core/components/formular.rkt

@@ -2,13 +2,14 @@
 
 (require (for-syntax racket/base
                      racket/syntax
-                     syntax/parse)
+                     syntax/parse/pre)
          forms
          koyo/haml
          (prefix-in m: marionette)
          racket/list
          racket/match
          racket/port
+         threading
          (prefix-in bot: (submod "bot.rkt" actions))
          (prefix-in study: "study.rkt")
          web-server/http)
@@ -38,7 +39,8 @@
  input-time
  textarea
  make-checkboxes
- make-radios)
+ make-radios
+ make-radios-with-other)
 
 (define (kwd->symbol kwd)
   (string->symbol (keyword->string kwd)))
@@ -157,7 +159,11 @@
          [{~or (kwd:keyword _)
                (kwd:keyword _ _)}
           #'(let ([entry (hash-ref tbl 'kwd)])
-              (rw (car entry) ((cdr entry) 'widget)))]
+              (let ([widget ((cdr entry) 'widget)])
+                (if widget
+                    (rw (car entry) widget)
+                    (((cdr entry) 'widget/ns)
+                     (widget-namespace (car entry) rw)))))]
 
          [(e ...)
           #`(#,@(map loop (syntax-e #'(e ...))))]
@@ -167,7 +173,11 @@
                        (syntax->datum #'(dynamic-field-id ...)))
           #:with kwd (datum->syntax #'e (string->keyword (symbol->string (syntax-e #'e))))
           #'(let ([entry (hash-ref tbl 'kwd)])
-              (rw (car entry) ((cdr entry) 'widget)))]
+              (let ([widget ((cdr entry) 'widget)])
+                (if widget
+                    (rw (car entry) widget)
+                    (((cdr entry) 'widget/ns)
+                     (widget-namespace (car entry) rw)))))]
 
          [e #'e]))
      #:with defaults
@@ -602,6 +612,76 @@
          (render-proc options make-radio)
          ,@((widget-errors) name value errors))))]))
 
+(define ((make-radios-with-other options
+                                 #:required? [required? #t]
+                                 #:other-label [other-label "Other:"]
+                                 #:radio-validators [radio-validators null]
+                                 #:other-validators [other-validators null]
+                                 #:radio-attributes [radio-attributes null]
+                                 #:other-attributes [other-attributes '((placeholder "Other..."))]) meth)
+  (match meth
+    ['validator
+     (form* ([radio-value (apply ensure binding/symbol radio-validators)]
+             [other-value (apply ensure binding/text other-validators)])
+       (if other-value
+           (ok other-value)
+           (if radio-value
+               (ok radio-value)
+               (if required?
+                   (err '((radio-value . "You must pick a value or write something in the other field.")))
+                   (ok #f)))))]
+    ['widget #f]
+    ['widget/ns
+     (lambda (rw)
+       (define (widget-radio-value name value _errors)
+         (let ([value (get-binding-value value)])
+           `(div
+             ,@(for/list ([opt (in-list options)])
+                 (match-define (cons option label)
+                   opt)
+                 `(div
+                   (label
+                    (input
+                     ([name ,name]
+                      [type "radio"]
+                      [value ,(symbol->string option)]
+                      ,@(if (eq? (string->symbol value) option)
+                            (cons '(checked "") radio-attributes)
+                            radio-attributes)))
+                    ,label))))))
+
+       (define (widget-other-value name value _errors)
+         `(label
+           ,other-label
+           (script
+            #<<SCRIPT
+function $$congame$$formular$$unradio() {
+  this.parentNode.parentNode.parentNode.querySelectorAll('[type=radio]').forEach(el => (el.checked = false));
+}
+SCRIPT
+            )
+           (input
+            ([name ,name]
+             [type "text"]
+             [value ,(get-binding-value value)]
+             [onchange "$$congame$$formular$$unradio.apply(this)"]
+             [onfocus "$$congame$$formular$$unradio.apply(this)"]
+             ,@other-attributes))))
+
+       (haml
+        (.group
+         (rw "radio-value" widget-radio-value)
+         ,@(rw "radio-value" (widget-errors))
+         (rw "other-value" widget-other-value)
+         ,@(rw "other-value" (widget-errors)))))]))
+
+(define (get-binding-value bind)
+  (or
+   (and~> bind
+          (binding:form-value)
+          (bytes->string/utf-8))
+   ""))
+
 
 ;; help ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 

congame-example-study/conscript-easy-forms.rkt

@@ -30,11 +30,15 @@
   (define twice-free-form
     (if free-form (* 2 free-form) "no value provided"))
 
+  (define radios-with-other
+    (get 'radios-with-other #f))
+
   @md{
     # Results so far
 
     1. Result from `Multiple Checkboxes`: @checkboxes
     2. Twice the result from `Free-Form Forms`: @(~a twice-free-form)
+    3. Radios with other: @(~a radios-with-other)
 
     @button{Go back to choosing Forms}})
 
@@ -211,6 +215,14 @@
       }
       @submit-button}}})
 
+(defstep (free-form-radios-with-other-choice)
+  @md{# Radios with "other" choice
+
+      @form{@binding[#:radios-with-other
+                     (make-radios-with-other '((a . "A")
+                                               (b . "B")))]
+            @submit-button}})
+
 (defstep (vertical-whitespace)
   @md{
     # More Vertical Whitespace
@@ -247,6 +259,10 @@
 
   [labeled-submit-button --> choose-page]
 
-  [free-form-forms1 --> free-form-forms2 --> display-results --> choose-page]
+  [free-form-forms1
+   --> free-form-forms2
+   --> free-form-radios-with-other-choice
+   --> display-results
+   --> choose-page]
 
   [vertical-whitespace --> choose-page])

conscript/form.rkt

@@ -21,7 +21,9 @@
   [congame:submit-button submit-button]
   [congame:submit-button/label submit-button/label]
   [congame:textarea textarea]
-  [congame:make-checkboxes make-checkboxes])
+  [congame:make-checkboxes make-checkboxes]
+  [congame:make-radios make-radios]
+  [congame:make-radios-with-other make-radios-with-other])
  form
  radios
  select