From c0a494de5aa2486e857a17e5ba0611268e563cc5 Mon Sep 17 00:00:00 2001
From: Jay McCarthy <jay.mccarthy@gmail.com>
Date: Wed, 12 Dec 2018 13:45:39 -0500
Subject: [PATCH] word

---
 scribblings/lux.scrbl | 34 ++++++++++++++++++++++++++++++++-
 word.rkt              | 44 +++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 77 insertions(+), 1 deletion(-)

diff --git a/scribblings/lux.scrbl b/scribblings/lux.scrbl
index 7ea3b7d..3b518ec 100644
--- a/scribblings/lux.scrbl
+++ b/scribblings/lux.scrbl
@@ -107,7 +107,39 @@ to mean "no output".}
 
 Returns a value for @racket[w] when the @racketmodname[lux] programs
 stops, which happens if @racket[word-event] or @racket[word-tick]
-return @racket[#f].}
+return @racket[#f]. By default, returns @racket[w].}
+
+@subsection{Word Construction}
+
+A @tech{word} can be created by defining a new @racket[struct] that
+implements the @racket[gen:word] generic interface@";" or, it can be
+defined using @racket[word]. The first method is best when it is easy
+to capture the state of the creation in a structure and the second is
+preferable when it is better to capture the state implicitly in the
+captured closures. In the author's experience, the second is also best
+for creations with complex control flow, because different sorts of
+@tech{word}s can be returned in different circumstances.
+
+@defproc[(word [base (or/c #f word?) #f]
+               [fps real? ....]
+               [label (or/c string? (-> real? string?)) ....]
+               [evt evt? ....]
+               [event (-> any/c (or/c #f word?)) ....]
+               [tick (-> (or/c #f word?)) ....]
+               [output any/c ....]
+               [return any/c ....])
+         word?]{
+
+Return a @tech{word} where the implementations of the methods are as
+given or inherited from @racket[base] or the defaults (described
+above). The only subtleties are that: (1) @racket[label] may be a
+string which is used directly and the frame time is not
+available@";" (2) @racket[event] is a function that only receives the
+generated event@";" (3) @racket[tick] is a thunk. The assumption is
+that the caller of @racket[word] can arrange for the value returned to
+be captured by these closures if necessary.
+
+}
 
 @subsection{Helpers}
 
diff --git a/word.rkt b/word.rkt
index 668bfdc..d152a2a 100644
--- a/word.rkt
+++ b/word.rkt
@@ -28,6 +28,41 @@
    (define (word-output w) #f)
    (define (word-return w) w)])
 
+(define (default b f d) (if b (f b) d))
+(struct *word (fps label evt event tick output return)
+  #:methods gen:word
+  [(define (word-fps w) (*word-fps w))
+   (define (word-label w ft)
+     (define h (*word-label w))
+     (if (string? h) h (h ft)))
+   (define (word-evt w) (*word-evt w))
+   (define (word-event w e)
+     (define h (*word-event w))
+     (if h (h e) w))
+   (define (word-tick w)
+     (define h (*word-tick w))
+     (if h (h) w))
+   (define (word-output w) (*word-output w))
+   (define (word-return w)
+     (or (*word-return w) w))])
+(define (word [b #f]
+              #:fps [fps (default b word-fps 60.0)]
+              #:label [label (if b
+                               (λ (ft) (word-label b ft))
+                               (λ (ft) (lux-standard-label "Lux" ft)))]
+              #:evt [evt (default b word-evt never-evt)]
+              #:event [event
+                       (if b
+                         (λ (e) (word-event b e))
+                         #f)]
+              #:tick [tick
+                      (if b
+                        (λ () (word-tick b))
+                        #f)]
+              #:output [output (default b word-output #f)]
+              #:return [return (default b word-return #f)])
+  (*word fps label evt event tick output return))
+
 (define (lux-standard-label l frame-time)
   (define fps (fl/ 1000.0 frame-time))
   (~a l
@@ -140,6 +175,15 @@
  (contract-out
   [word?
    (-> any/c word?)]
+  [word (->* () ((or/c #f word?)
+                 #:fps real?
+                 #:label (or/c string? (-> real? string?))
+                 #:evt evt?
+                 #:event (-> any/c (or/c #f word?))
+                 #:tick (-> (or/c #f word?))
+                 #:output any/c
+                 #:return any/c)
+             word?)]
   [lux-standard-label
    (-> string? flonum?
        string?)]