diff --git a/_web_server/server/playground-server.scm b/_web_server/server/playground-server.scm
index 4dbbce0..ef06232 100755
--- a/_web_server/server/playground-server.scm
+++ b/_web_server/server/playground-server.scm
@@ -19,7 +19,8 @@
(ice-9 popen))
(import (embddr common)
- (embddr optargs))
+ (embddr optargs)
+ (embddr vcd))
(define INDEX-FILE "index.html")
(define DELETE-WORK-DIR #t)
@@ -196,6 +197,221 @@
#:content-type content-type
#:content-type-params content-type-params))
+;;;
+;;; Simple format with convert input number to inexact numbers
+;;;
+(define (format-inex . args)
+ (apply format
+ (map (lambda (arg)
+ (if (number? arg)
+ (exact->inexact
+ (/ (round (* arg 100)) 100))
+ arg))
+ args)))
+
+;;;
+;;; Make SVG drawing of VCD signals
+;;;
+(define* (vcd-signal->svg signal tstart tend x y width height text-position
+ #:key (id #f) (data-hw 3))
+ (let* ((time-per-pixel (/ (- tend tstart) width))
+ (sig-width (vcd-signal-size signal))
+ (sig-type (vcd-signal-type signal))
+ (y0 y)
+ (y1 (+ y height))
+ (yz (+ y (/ height 2)))
+ (half-dy (/ (- y1 y0) 2))
+ (id (if id (format " id=\"~a\"" id) "")))
+
+ (let next-sample ((samples (append (vcd-signal-get signal) `((,tend . "-"))))
+ (value (if (eq? sig-type 'real)
+ 0
+ (make-string sig-width #\x)))
+ (time tstart)
+ (svg '()))
+
+ (if (null? samples)
+ svg
+ (let ((sample-time (car (car samples)))
+ (sample-value (cdr (car samples))))
+ (if (or (< (- sample-time time) time-per-pixel)
+ (and (equal? value sample-value)
+ (not (eq? sig-type 'event))))
+ (next-sample
+ (cdr samples)
+ (if (<= sample-time tstart)
+ sample-value
+ value)
+ time svg)
+ (next-sample
+ (cdr samples) sample-value sample-time
+ (cons
+ (cond
+ ((or (eq? sig-type 'bits)
+ (eq? sig-type 'real))
+
+ (if (and (= sig-width 1)
+ (not (eq? sig-type 'real))
+ (not (char-ci=? (string-ref value 0) #\x)))
+ ;; Scalar
+ (let ((x0 (+ x (/ (- time tstart) time-per-pixel)))
+ (x1 (+ x (/ (- sample-time tstart) time-per-pixel))))
+ (string-append
+ (format-inex "" id x0 y0 (- y1 y0))
+ (format-inex ""
+ id x0
+ (cond
+ ((equal? value "0") y1)
+ ((equal? value "1") y0)
+ (else yz))
+ (- x1 x0))))
+
+ ;; Vector or Real
+ (let ((x0 (+ x (/ (- time tstart) time-per-pixel)))
+ (x1 (+ x (/ (- sample-time tstart) time-per-pixel))))
+ (string-append
+ ;; Horizontal lines
+ (let ((x0 (+ x0 (if (<= time tstart) 0 data-hw)))
+ (x1 (- x1 (if (>= sample-time tend) 0 data-hw))))
+ (format-inex
+ ""
+ id x0 y0 x1 y0 x0 y1 x1 y1))
+
+ ;; Left cross
+ (if (<= time tstart)
+ ""
+ (format-inex ""
+ id
+ x0 yz data-hw (- half-dy)
+ x0 yz data-hw (+ half-dy)))
+
+ ;; Right cross
+ (if (>= sample-time tend)
+ ""
+ (format-inex ""
+ id
+ x1 yz (- data-hw) (- half-dy)
+ x1 yz (- data-hw) (+ half-dy)))
+
+ ;; Text
+ (format-inex ""))))
+
+ ;; Real number
+ ((eq? sig-type 'real)
+ "")
+
+ ;; Event
+ ((eq? sig-type 'event)
+ ""))
+ svg))))))))
+
+;;;
+;;; Make legend SVG text for VCD
+;;;
+(define* (vcd-signals->legend signals text-spacing text-position)
+ (map
+ (lambda (sig n)
+ (string-append
+ (format-inex "~a"
+ (+ (* n text-spacing) text-position)
+ (vcd-signal-name sig))))
+ signals
+ (iota (length signals))))
+
+;;;
+;;; Create SVG from VCD
+;;;
+(define* (vcd->svg vcd width #:key
+ (signal-height 15)
+ (signal-text-position 12)
+ (margin 5)
+ (signal-spacing 5)
+ (legend-width 100)
+ (extra-delim-y 3))
+
+ (let ((tstart (apply min (vcd-timestamps vcd)))
+ (tend (apply max (vcd-timestamps vcd)))
+ (signals (sort
+ (remove
+ (lambda (sig) (< (length (vcd-signal-scope sig)) 2))
+ (vcd-signals vcd))
+ (lambda (a b)
+ (or
+ (and (equal? (vcd-signal-name a) "clock")
+ (not (equal? (vcd-signal-name b) "clock")))
+
+ (< (length (vcd-signal-scope a))
+ (length (vcd-signal-scope b)))
+
+ (string-ci (vcd-signal-name a)
+ (vcd-signal-name b)))))))
+
+ (let ((signals-x (+ (* 2 margin) legend-width))
+ (signals-w (- width legend-width (* 3 margin)))
+ (height
+ (+ (* 2 margin)
+ (* signal-height (length signals))
+ (* signal-spacing (- (length signals) 1)))))
+
+ (append
+ ;; Header
+ (list
+ (format-inex "")))))
+
;;;
;;; Execute system command and capture stdout and stderr to string
;;;