Initialize

.gitignore

@@ -0,0 +1,5 @@
+*~
+\#*
+.\#*
+.DS_Store
+compiled

.travis.yml

@@ -0,0 +1,42 @@
+language: c
+
+# Supply at least one RACKET_VERSION environment variable definition
+# here. RACKET_VERSION is used by the install-racket.sh script
+# (specifed below under before_install) to select the version of
+# Racket to download and install.
+#
+# If you supply more than one, you can create multiple builds (a
+# Travis-CI build matrix resulting in multiple builds). You can use
+# this to test against multiple Racket versions.
+env:
+ - RACKET_VERSION=6.0
+ - RACKET_VERSION=6.0.1
+ - RACKET_VERSION=6.1
+ - RACKET_VERSION=6.1.1
+ - RACKET_VERSION=HEAD
+
+before_install:
+- git clone https://github.com/greghendershott/travis-racket.git
+- cat travis-racket/install-racket.sh | bash # pipe to bash not sh!
+
+install:
+
+before_script:
+
+# Here supply steps such as raco make, raco test, etc.  Note that you
+# need to supply /usr/racket/bin/ -- it's not in PATH. You can run
+# `raco pkg install --deps search-auto <<name>>` to install any required
+# packages without it getting stuck on a confirmation prompt.
+script:
+ - /usr/racket/bin/raco make main.rkt
+ - /usr/racket/bin/raco test -x .
+
+# NOTE: If your repo is a Racket package with an info.rkt that
+# includes some `deps`, the following is more elegant:
+#
+# script:
+# - cd ..   # Travis did a cd into the dir. Back up, for the next:
+# - /usr/racket/bin/raco pkg install --deps search-auto --link <<name>>
+# - /usr/racket/bin/raco test -x -p <<name>>
+
+after_script:

LICENSE

@@ -0,0 +1,5 @@
+This code is available according to same terms as Racket:
+
+http://download.racket-lang.org/license.html
+
+Copyright © Jay McCarthy

README

@@ -0,0 +1 @@
+lux - a simple library for creating real-time graphical apps

info.rkt

@@ -0,0 +1,9 @@
+#lang info
+(define collection "lux")
+(define deps '("base"
+               "rackunit-lib"))
+(define build-deps '("scribble-lib" "racket-doc"))
+(define scribblings '(("scribblings/lux.scrbl" ())))
+(define pkg-desc "a simple library for creating real-time graphical apps")
+(define version "0.0")
+(define pkg-authors '(jay))

main.rkt

@@ -0,0 +1,142 @@
+#lang racket/base
+(require racket/list
+         racket/match
+         racket/contract/base
+         racket/flonum
+         racket/format
+         racket/generic)
+
+;; xxx abstract away sources (input events) and sinks (gui and sound)?
+(define draw-mode/c
+  (one-of/c 'draw 'gl))
+
+(define-generics word
+  (word-label word frame-time)
+  (word-fps word)
+  (word-tick word events)
+  (word-draw-mode word)
+  (word-draw! word width height dc)
+  (word-pause word)
+  (word-resume word state)
+  (word-stop? word)
+  (word-value word)
+  #:fallbacks
+  [(define (word-label w frame-time)
+     (lux-standard-label "Lux" frame-time))
+   (define (word-fps w)
+     60.0)
+   (define (word-tick w es) w)
+   (define (word-draw-mode w) 'draw)
+   (define (word-draw! w width height dc) (void))
+   (define (word-pause w) w)
+   (define (word-resume w) w)
+   (define (word-stop? w) #f)
+   (define (word-value w) w)])
+
+(define (lux-standard-label l frame-time)
+  (~a l
+      ": "
+      "Frame time: "
+      (~r frame-time
+          #:min-width 5
+          #:precision 1)
+      "ms; "
+      "FPS: "
+      (~r (fl/ 1000.0 frame-time)
+          #:min-width 7
+          #:precision 2)))
+
+(define current-world (make-parameter #f))
+(struct world (t ch))
+(struct message (w pmz return-t return-ch time-evt))
+(define-syntax-rule (call pmz e)
+  (call-with-continuation-barrier
+   (λ () (call-with-parameterization pmz (λ () e)))))
+(define (start-world)
+  (define submit-ch (make-channel))
+  (define the-gui (start-gui))
+  (define (body old-stack)
+    ;; xxx i dislike that i don't know if old-stack is '()
+    (gui-yield
+     the-gui
+     (choice-evt
+      (match old-stack
+        ['()
+         never-evt]
+        [(cons old-m stack)
+         (match-define (message w pmz return-t return-ch time-evt) old-m)
+         (handle-evt
+          time-evt
+          (λ (_)
+            (define start-time (current-inexact-milliseconds))
+            (define es (gui-events the-gui))
+            ;; I fear that (call pmz e) is slow and I do it a lot
+            ;; here. So maybe change tick to return all this stuff?
+            (define new-w (call pmz (word-tick w es)))
+            (gui-draw!
+             the-gui
+             (call pmz (word-draw-mode new-w))
+             (λ (width height dc)
+               (call pmz (word-draw! new-w width height dc))))
+            (define end-time (current-inexact-milliseconds))
+            (define frame-time (fl- end-time start-time))
+            (define new-label
+              (call pmz (word-label new-w frame-time)))
+            (gui-label! the-gui new-label)
+            (match (call pmz (word-stop? new-w))
+              [#f
+               (define fps (call pmz (word-fps new-w)))
+               (define next-time (fl+ start-time (fl* (fl/ 1.0 fps) 1000.0)))
+               (define next-time-evt (alarm-evt next-time))
+               (define new-m
+                 (message new-w pmz return-t return-ch next-time-evt))
+               (body (cons new-m stack))]
+              [#t
+               (thread-resume return-t)
+               (channel-put return-ch (word-value w))
+               (body
+                (match stack
+                  ['()
+                   stack]
+                  [(cons old-m stack)
+                   (match-define (message w pmz return-t return-ch time-evt) old-m)
+                   (cons (message (call pmz (word-resume w))
+                                  pmz return-t return-ch time-evt)
+                         stack)]))])))])
+      (handle-evt
+       submit-ch
+       (λ (new-m)
+         (body
+          (cons new-m
+                (match old-stack
+                  ['()
+                   old-stack]
+                  [(cons old-m stack)
+                   (match-define (message w pmz return-t return-ch time-evt) old-m)
+                   (cons (message (call pmz (word-pause w))
+                                  pmz return-t return-ch time-evt)
+                         stack)]))))))))
+  (define world-t
+    (thread
+     (λ ()
+       (body empty))))
+  (world world-t submit-ch))
+
+(define (fiat-lux w)
+  (if (current-world)
+      (fictio-fiat-lux w)
+      (factum-fiat-lux w)))
+
+(define (factum-fiat-lux w)
+  (parameterize ([current-world (start-world)])
+    (fictio-fiat-lux w)))
+;; xxx this isn't going to work because the server won't be listening inside tick
+(define (fictio-fiat-lux w)
+  (define return-ch (make-channel))
+  (match-define (world world-t submit-ch) (current-world))
+  (thread-resume world-t)
+  (define m (message w (current-parameterization)
+                     (current-thread) return-ch
+                     always-evt))
+  (channel-put! submit-ch m)
+  (channel-get return-ch))

scribblings/lux.scrbl

@@ -0,0 +1,10 @@
+#lang scribble/manual
+@require[@for-label[lux
+                    racket/base]]
+
+@title{lux}
+@author{jay}
+
+@defmodule[lux]
+
+Package Description Here