(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-LiteralVector3 (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-LiteralVector3 (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)))