syndicate-lang
/
syndicate-2017
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Omit empty patches in render-msd

This commit is contained in:
Tony Garnock-Jones 2017-09-18 16:14:22 +01:00
parent 2a5d8ebdd4
commit 903ed5deaa
1 changed files with 26 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
racket/syndicate/trace/render-msd.rkt
View File

@ -21,11 +21,17 @@
;;--------------------------------------------------------------------------- ;;---------------------------------------------------------------------------
(define OMIT-EMPTY-PATCHES? (make-parameter #f))
(define (find-unused-lane swimlane-map) (define (find-unused-lane swimlane-map)
(let ((used-lanes (list->set (hash-values swimlane-map)))) (let ((used-lanes (list->set (hash-values swimlane-map))))
(do ((i 0 (+ i 1))) (do ((i 0 (+ i 1)))
((not (set-member? used-lanes i)) i)))) ((not (set-member? used-lanes i)) i))))
(define (empty-patch-description? desc)
;; Ewww.
(equal? desc "- ::: nothing\n+ ::: nothing\n"))
(define (read-msd port) (define (read-msd port)
(define max-lane -1) (define max-lane -1)
(define swimlane-map (make-hash)) (define swimlane-map (make-hash))
@ -94,12 +100,13 @@
[1 "1 action"] [1 "1 action"]
[n (format "~a actions" n)])))] [n (format "~a actions" n)])))]
[(list source sink 'action-interpreted _ desc) [(list source sink 'action-interpreted _ desc)
(define shifted-sink (when (not (and (OMIT-EMPTY-PATCHES?) (empty-patch-description? desc)))
(if source (define shifted-sink
(spacetime (spacetime-space source) (spacetime-time sink)) (if source
sink)) (spacetime (spacetime-space source) (spacetime-time sink))
(emit-events (annotate-swimlane (translate! shifted-sink) ACTION-COLOR desc) sink))
(connection* source shifted-sink))] (emit-events (annotate-swimlane (translate! shifted-sink) ACTION-COLOR desc)
(connection* source shifted-sink)))]
[(list source sink 'quit) [(list source sink 'quit)
(define shifted-sink (define shifted-sink
(if source (if source
@ -108,14 +115,15 @@
(emit-events (begin0 (end-swimlane (translate! shifted-sink)) (emit-events (begin0 (end-swimlane (translate! shifted-sink))
(when source (vacate-lane! shifted-sink))))] (when source (vacate-lane! shifted-sink))))]
[(list direct-cause recipient 'event _ desc indirect-cause doubly-indirect-paths) [(list direct-cause recipient 'event _ desc indirect-cause doubly-indirect-paths)
(apply emit-events (when (not (and (OMIT-EMPTY-PATCHES?) (empty-patch-description? desc)))
(annotate-swimlane (translate! recipient) EVENT-COLOR desc) (apply emit-events
;; (connection* direct-cause recipient) (annotate-swimlane (translate! recipient) EVENT-COLOR desc)
;; (connection* indirect-cause recipient) ;; (connection* direct-cause recipient)
(map (lambda (doubly-indirect-path) ;; (connection* indirect-cause recipient)
(connection (translate*! doubly-indirect-path (spacetime-time direct-cause)) (map (lambda (doubly-indirect-path)
(translate! recipient))) (connection (translate*! doubly-indirect-path (spacetime-time direct-cause))
doubly-indirect-paths))]) (translate! recipient)))
doubly-indirect-paths)))])
(loop)]))) (loop)])))
;;--------------------------------------------------------------------------- ;;---------------------------------------------------------------------------
@ -346,6 +354,10 @@
(define filename (define filename
(command-line (command-line
#:once-each #:once-each
[("--omit-empty-patches") "Omits empty patches from display"
(OMIT-EMPTY-PATCHES? #t)]
[("--no-omit-empty-patches") "Includes empty patches in display"
(OMIT-EMPTY-PATCHES? #f)]
[("-s" "--scale") scale "Rescales output; 1 = 100%" [("-s" "--scale") scale "Rescales output; 1 = 100%"
(set! *scale* (string->number scale))] (set! *scale* (string->number scale))]
[("-t" "--target") target "Choose target: screen, png, png@2x, svg, eps, pdf" [("-t" "--target") target "Choose target: screen, png, png@2x, svg, eps, pdf"