Lots of boxes
This commit is contained in:
parent
cfefa8d39a
commit
e23e964486
|
@ -0,0 +1,12 @@
|
||||||
|
# See https://gitlab.com/preserves/preserves/-/issues/39
|
||||||
|
WORKAROUND_PRESERVES_ISSUE_39=--base `realpath ../protocols/schemas`/
|
||||||
|
|
||||||
|
schemas:
|
||||||
|
preserves-schema-rkt \
|
||||||
|
--output schemas \
|
||||||
|
$(WORKAROUND_PRESERVES_ISSUE_39) \
|
||||||
|
--module noise=:syndicate/schemas/noise \
|
||||||
|
../protocols/schemas/**.prs
|
||||||
|
|
||||||
|
clean:
|
||||||
|
rm -rf schemas/
|
|
@ -0,0 +1,43 @@
|
||||||
|
#lang syndicate
|
||||||
|
|
||||||
|
(module+ main
|
||||||
|
(require syndicate/distributed/tcp)
|
||||||
|
(require syndicate/drivers/timer)
|
||||||
|
(require syndicate/gensym)
|
||||||
|
(require racket/math)
|
||||||
|
|
||||||
|
(require "schemas/scene.rkt")
|
||||||
|
(require "schemas/shapes.rkt")
|
||||||
|
|
||||||
|
(assertion-struct SceneHandle (ds))
|
||||||
|
|
||||||
|
(standard-actor-system (ds)
|
||||||
|
(define (on-connected remote-ds)
|
||||||
|
(at remote-ds
|
||||||
|
(during (SceneHandle $scene-e)
|
||||||
|
(define scene (embedded-value scene-e))
|
||||||
|
|
||||||
|
(define (bouncy-box)
|
||||||
|
(define me (symbol->string (strong-gensym 'user)))
|
||||||
|
(define start-time (current-inexact-milliseconds))
|
||||||
|
(define-field deadline start-time)
|
||||||
|
(define-field x (* (- (random) 0.5) 100))
|
||||||
|
(define y0 (+ 1.0 (* (random) 10)))
|
||||||
|
(define-field y y0)
|
||||||
|
(define-field z (* (- (random) 0.5) 100))
|
||||||
|
(at ds
|
||||||
|
(on (asserted (LaterThan (deadline)))
|
||||||
|
(deadline (+ (deadline) (/ 1000 10)))
|
||||||
|
(y (+ y0 (cos (/ (- (deadline) start-time) 1000.0 (/ 1 2 pi)))))))
|
||||||
|
(define r (random))
|
||||||
|
(define g (random))
|
||||||
|
(define b (random))
|
||||||
|
(at scene
|
||||||
|
(assert (Sprite me (Move (Vector3 (x) (y) (z))
|
||||||
|
(Color-opaque r g b (Box)))))
|
||||||
|
))
|
||||||
|
|
||||||
|
(for [(i 100)] (bouncy-box)))))
|
||||||
|
|
||||||
|
(run-tcp-client-relay ds #:hostname "vr.demo.leastfixedpoint.com" #:port 9001
|
||||||
|
#:import (lambda (v) (on-connected (embedded-value v))))))
|
|
@ -0,0 +1,148 @@
|
||||||
|
(module scene racket/base
|
||||||
|
(provide (except-out (all-defined-out) :decode-embedded :encode-embedded)
|
||||||
|
(rename-out
|
||||||
|
(:decode-embedded decode-embedded:scene)
|
||||||
|
(:encode-embedded encode-embedded:scene)))
|
||||||
|
(require preserves)
|
||||||
|
(require preserves-schema/methods)
|
||||||
|
(require preserves-schema/support)
|
||||||
|
(require racket/match)
|
||||||
|
(require racket/set)
|
||||||
|
(require racket/dict)
|
||||||
|
(require (only-in racket/generic define/generic))
|
||||||
|
(require (prefix-in noise: syndicate/schemas/noise))
|
||||||
|
(require (prefix-in shapes: "shapes.rkt"))
|
||||||
|
(define :decode-embedded values)
|
||||||
|
(define :encode-embedded values)
|
||||||
|
(struct
|
||||||
|
AmbientSound
|
||||||
|
(name spec)
|
||||||
|
#:transparent
|
||||||
|
#:methods
|
||||||
|
gen:preservable
|
||||||
|
((define/generic *->preserve ->preserve)
|
||||||
|
(define (->preserve preservable)
|
||||||
|
(match
|
||||||
|
preservable
|
||||||
|
((AmbientSound ?name ?spec)
|
||||||
|
(record
|
||||||
|
'ambient-sound
|
||||||
|
(list (*->preserve ?name) (*->preserve ?spec))))))))
|
||||||
|
(define (parse-AmbientSound input)
|
||||||
|
(match
|
||||||
|
input
|
||||||
|
((and dest
|
||||||
|
(record
|
||||||
|
'ambient-sound
|
||||||
|
(list
|
||||||
|
(and ?name (? string?))
|
||||||
|
(app shapes:parse-SoundSpec (and ?spec (not (== eof)))))))
|
||||||
|
(AmbientSound ?name ?spec))
|
||||||
|
(_ eof)))
|
||||||
|
(define parse-AmbientSound!
|
||||||
|
(parse-success-or-error 'parse-AmbientSound parse-AmbientSound))
|
||||||
|
(struct
|
||||||
|
Gravity
|
||||||
|
(direction)
|
||||||
|
#:transparent
|
||||||
|
#:methods
|
||||||
|
gen:preservable
|
||||||
|
((define/generic *->preserve ->preserve)
|
||||||
|
(define (->preserve preservable)
|
||||||
|
(match
|
||||||
|
preservable
|
||||||
|
((Gravity ?direction)
|
||||||
|
(record 'gravity (list (*->preserve ?direction))))))))
|
||||||
|
(define (parse-Gravity input)
|
||||||
|
(match
|
||||||
|
input
|
||||||
|
((and dest
|
||||||
|
(record
|
||||||
|
'gravity
|
||||||
|
(list (app shapes:parse-Vector3 (and ?direction (not (== eof)))))))
|
||||||
|
(Gravity ?direction))
|
||||||
|
(_ eof)))
|
||||||
|
(define parse-Gravity! (parse-success-or-error 'parse-Gravity parse-Gravity))
|
||||||
|
(struct
|
||||||
|
Portal
|
||||||
|
(name destination position)
|
||||||
|
#:transparent
|
||||||
|
#:methods
|
||||||
|
gen:preservable
|
||||||
|
((define/generic *->preserve ->preserve)
|
||||||
|
(define (->preserve preservable)
|
||||||
|
(match
|
||||||
|
preservable
|
||||||
|
((Portal ?name ?destination ?position)
|
||||||
|
(record
|
||||||
|
'portal
|
||||||
|
(list
|
||||||
|
(*->preserve ?name)
|
||||||
|
(*->preserve ?destination)
|
||||||
|
(*->preserve ?position))))))))
|
||||||
|
(define (parse-Portal input)
|
||||||
|
(match
|
||||||
|
input
|
||||||
|
((and dest
|
||||||
|
(record
|
||||||
|
'portal
|
||||||
|
(list
|
||||||
|
(and ?name (? string?))
|
||||||
|
(app parse-PortalDestination (and ?destination (not (== eof))))
|
||||||
|
(app shapes:parse-Vector3 (and ?position (not (== eof)))))))
|
||||||
|
(Portal ?name ?destination ?position))
|
||||||
|
(_ eof)))
|
||||||
|
(define parse-Portal! (parse-success-or-error 'parse-Portal parse-Portal))
|
||||||
|
(define (PortalDestination? p)
|
||||||
|
(or (PortalDestination-local? p) (PortalDestination-remote? p)))
|
||||||
|
(struct
|
||||||
|
PortalDestination-local
|
||||||
|
(value)
|
||||||
|
#:transparent
|
||||||
|
#:methods
|
||||||
|
gen:preservable
|
||||||
|
((define/generic *->preserve ->preserve)
|
||||||
|
(define (->preserve preservable)
|
||||||
|
(match preservable ((PortalDestination-local src) (embedded src))))))
|
||||||
|
(struct
|
||||||
|
PortalDestination-remote
|
||||||
|
(value)
|
||||||
|
#:transparent
|
||||||
|
#:methods
|
||||||
|
gen:preservable
|
||||||
|
((define/generic *->preserve ->preserve)
|
||||||
|
(define (->preserve preservable)
|
||||||
|
(match preservable ((PortalDestination-remote src) (*->preserve src))))))
|
||||||
|
(define (parse-PortalDestination input)
|
||||||
|
(match
|
||||||
|
input
|
||||||
|
((embedded dest) (PortalDestination-local dest))
|
||||||
|
((app noise:parse-Route (and dest (not (== eof))))
|
||||||
|
(PortalDestination-remote dest))
|
||||||
|
(_ eof)))
|
||||||
|
(define parse-PortalDestination!
|
||||||
|
(parse-success-or-error 'parse-PortalDestination parse-PortalDestination))
|
||||||
|
(struct
|
||||||
|
Touch
|
||||||
|
(subject object)
|
||||||
|
#:transparent
|
||||||
|
#:methods
|
||||||
|
gen:preservable
|
||||||
|
((define/generic *->preserve ->preserve)
|
||||||
|
(define (->preserve preservable)
|
||||||
|
(match
|
||||||
|
preservable
|
||||||
|
((Touch ?subject ?object)
|
||||||
|
(record
|
||||||
|
'touch
|
||||||
|
(list (*->preserve ?subject) (*->preserve ?object))))))))
|
||||||
|
(define (parse-Touch input)
|
||||||
|
(match
|
||||||
|
input
|
||||||
|
((and dest
|
||||||
|
(record
|
||||||
|
'touch
|
||||||
|
(list (and ?subject (? string?)) (and ?object (? string?)))))
|
||||||
|
(Touch ?subject ?object))
|
||||||
|
(_ eof)))
|
||||||
|
(define parse-Touch! (parse-success-or-error 'parse-Touch parse-Touch)))
|
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue