Update bot

This commit is contained in:
Tony Garnock-Jones 2023-02-16 21:41:19 +01:00
parent f0f6f73c1f
commit 91a7334351
5 changed files with 156 additions and 5 deletions

View File

@ -1,7 +1,7 @@
schemas:
preserves-schema-rkt \
--output schemas \
--module noise=:syndicate/schemas/noise \
--module gatekeeper=:syndicate/schemas/gatekeeper \
../protocols/schemas/**.prs
clean:

View File

@ -31,7 +31,7 @@
(define start-time (current-inexact-milliseconds))
(define-field deadline start-time)
(at ds
(on (asserted (LaterThan (deadline)))
(on (asserted (LaterThan (/ (deadline) 1000.0)))
(deadline (+ (deadline) (/ 1000 30)))
(y (+ y0 (cos (/ (- (deadline) start-time) 1000.0 (/ 1 2 pi)))))))

View File

@ -10,7 +10,7 @@
(require racket/set)
(require racket/dict)
(require (only-in racket/generic define/generic))
(require (prefix-in noise: syndicate/schemas/noise))
(require (prefix-in gatekeeper: syndicate/schemas/gatekeeper))
(require (prefix-in shapes: "shapes.rkt"))
(define :decode-embedded values)
(define :encode-embedded values)
@ -122,7 +122,7 @@
(match
input
((embedded dest) (PortalDestination-local dest))
((app noise:parse-Route (and dest (not (== eof))))
((app gatekeeper:parse-Route (and dest (not (== eof))))
(PortalDestination-remote dest))
(_ eof)))
(define parse-PortalDestination!

View File

@ -10,6 +10,7 @@
(require racket/set)
(require racket/dict)
(require (only-in racket/generic define/generic))
(require (prefix-in turtle: "turtle.rkt"))
(define :decode-embedded values)
(define :encode-embedded values)
(struct
@ -509,7 +510,8 @@
(Mesh-Box? p)
(Mesh-Ground? p)
(Mesh-Plane? p)
(Mesh-External? p)))
(Mesh-External? p)
(Mesh-turtle? p)))
(struct
Mesh-Sphere
(value)
@ -555,6 +557,15 @@
((define/generic *->preserve ->preserve)
(define (->preserve preservable)
(match preservable ((Mesh-External src) (*->preserve src))))))
(struct
Mesh-turtle
(value)
#:transparent
#:methods
gen:preservable
((define/generic *->preserve ->preserve)
(define (->preserve preservable)
(match preservable ((Mesh-turtle src) (*->preserve src))))))
(define (parse-Mesh input)
(match
input
@ -563,6 +574,7 @@
((app parse-Ground (and dest (not (== eof)))) (Mesh-Ground dest))
((app parse-Plane (and dest (not (== eof)))) (Mesh-Plane dest))
((app parse-External (and dest (not (== eof)))) (Mesh-External dest))
((app turtle:parse-Shape (and dest (not (== eof)))) (Mesh-turtle dest))
(_ eof)))
(define parse-Mesh! (parse-success-or-error 'parse-Mesh parse-Mesh))
(struct

139
bot/schemas/turtle.rkt Normal file
View File

@ -0,0 +1,139 @@
(module turtle racket/base
(provide (except-out (all-defined-out) :decode-embedded :encode-embedded)
(rename-out
(:decode-embedded decode-embedded:turtle)
(:encode-embedded encode-embedded:turtle)))
(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))
(define :decode-embedded values)
(define :encode-embedded values)
(struct
Block
(value)
#:transparent
#:methods
gen:preservable
((define/generic *->preserve ->preserve)
(define (->preserve preservable)
(match
preservable
((Block src) (for/list ((item (in-list src))) (*->preserve item)))))))
(define (parse-Block input)
(match
input
((list (app parse-Token (and dest (not (== eof)))) ...) (Block dest))
(_ eof)))
(define parse-Block! (parse-success-or-error 'parse-Block parse-Block))
(struct
Program
(value)
#:transparent
#:methods
gen:preservable
((define/generic *->preserve ->preserve)
(define (->preserve preservable)
(match preservable ((Program src) (*->preserve src))))))
(define (parse-Program input)
(match
input
((app parse-Block (and dest (not (== eof)))) (Program dest))
(_ eof)))
(define parse-Program! (parse-success-or-error 'parse-Program parse-Program))
(struct
Shape
(program)
#:transparent
#:methods
gen:preservable
((define/generic *->preserve ->preserve)
(define (->preserve preservable)
(match
preservable
((Shape ?program) (record 'turtle (list (*->preserve ?program))))))))
(define (parse-Shape input)
(match
input
((and dest
(record
'turtle
(list (app parse-Program (and ?program (not (== eof)))))))
(Shape ?program))
(_ eof)))
(define parse-Shape! (parse-success-or-error 'parse-Shape parse-Shape))
(define (Token? p)
(or (Token-i? p)
(Token-d? p)
(Token-b? p)
(Token-s? p)
(Token-v? p)
(Token-block? p)))
(struct
Token-i
(value)
#:transparent
#:methods
gen:preservable
((define/generic *->preserve ->preserve)
(define (->preserve preservable)
(match preservable ((Token-i src) (*->preserve src))))))
(struct
Token-d
(value)
#:transparent
#:methods
gen:preservable
((define/generic *->preserve ->preserve)
(define (->preserve preservable)
(match preservable ((Token-d src) (exact->inexact (*->preserve src)))))))
(struct
Token-b
(value)
#:transparent
#:methods
gen:preservable
((define/generic *->preserve ->preserve)
(define (->preserve preservable)
(match preservable ((Token-b src) (*->preserve src))))))
(struct
Token-s
(value)
#:transparent
#:methods
gen:preservable
((define/generic *->preserve ->preserve)
(define (->preserve preservable)
(match preservable ((Token-s src) (*->preserve src))))))
(struct
Token-v
(value)
#:transparent
#:methods
gen:preservable
((define/generic *->preserve ->preserve)
(define (->preserve preservable)
(match preservable ((Token-v src) (*->preserve src))))))
(struct
Token-block
(value)
#:transparent
#:methods
gen:preservable
((define/generic *->preserve ->preserve)
(define (->preserve preservable)
(match preservable ((Token-block src) (*->preserve src))))))
(define (parse-Token input)
(match
input
((and dest (? exact-integer?)) (Token-i dest))
((and dest (? flonum?)) (Token-d dest))
((and dest (? boolean?)) (Token-b dest))
((and dest (? string?)) (Token-s dest))
((and dest (? symbol?)) (Token-v dest))
((app parse-Block (and dest (not (== eof)))) (Token-block dest))
(_ eof)))
(define parse-Token! (parse-success-or-error 'parse-Token parse-Token)))