Browse Source

Initialize

master
Jay McCarthy 6 years ago
commit
52dc84e8bd
7 changed files with 214 additions and 0 deletions
  1. +5
    -0
      .gitignore
  2. +42
    -0
      .travis.yml
  3. +5
    -0
      LICENSE
  4. +1
    -0
      README
  5. +9
    -0
      info.rkt
  6. +142
    -0
      main.rkt
  7. +10
    -0
      scribblings/lux.scrbl

+ 5
- 0
.gitignore View File

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

+ 42
- 0
.travis.yml View File

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

+ 5
- 0
LICENSE View File

@@ -0,0 +1,5 @@
This code is available according to same terms as Racket:

http://download.racket-lang.org/license.html

Copyright © Jay McCarthy

+ 1
- 0
README View File

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

+ 9
- 0
info.rkt View File

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

+ 142
- 0
main.rkt View File

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

+ 10
- 0
scribblings/lux.scrbl View File

@@ -0,0 +1,10 @@
#lang scribble/manual
@require[@for-label[lux
racket/base]]

@title{lux}
@author{jay}

@defmodule[lux]

Package Description Here

Loading…
Cancel
Save