Fix title absent

embddr/common.scm

@@ -19,6 +19,7 @@
           has-duplicates? find-duplicates
           insert-between
           string-replace-text
+          string-split-str
           string-split-trim
           get-word
           substitute
@@ -220,6 +221,18 @@
            (substitute str template-format subst-list))
          ls)))
 
+;;; Split the string STR into a list of the substrings delimited by DELIMITER
+(define (string-split-str str delimiter)
+  (if (string-null? str)
+      '()
+      (let ((didx (string-contains str delimiter)))
+        (if didx
+            (cons (substring str 0 didx)
+                  (string-split-str
+                   (substring str (+ didx (string-length delimiter)))
+                   delimiter))
+            (list str)))))
+
 ;;; Split string and remove empty itemes
 (define (string-split-trim str pred?)
   (remove string-null?

embddr/gnuplot.scm

@@ -0,0 +1,117 @@
+(define-module (embddr gnuplot))
+
+(import (srfi srfi-1)
+        (srfi srfi-26)
+        (ice-9 popen)
+        (ice-9 format))
+
+(export make-plot-xy
+        plot)
+
+;;;
+;;; println
+;;;
+(define (>> . args)
+  (when (not (null? args))
+    (apply format (cons #t args)))
+  (newline))
+
+;;;
+;;; Call app and write to stdin
+;;;
+(define (with-output-to-spawn cmd f)
+  (let ((port (open-output-pipe cmd)))
+    (with-output-to-port port f)
+    (force-output port)
+    (close-pipe port)))
+
+;;;
+;;; Make plot
+;;;
+(define* (make-plot-xy #:key
+                       (x #f)           ; abscissa
+                       y                ; ordinate
+                       (title #f)
+                       (with "lines"))
+  (let ((x (or x (iota (length y)))))
+    (if (not (= (length x)
+                (length y)))
+        (error "Length of X and Y lists is not equal")
+        (lambda (key)
+          (case key
+            ((x) x)
+            ((y) y)
+            ((title) (or title ""))
+            ((with) with)
+            (else #f))))))
+
+;;;
+;;; Plot plots
+;;;
+(define* (plot plots
+               #:key
+               (xlabel #f)
+               (ylabel #f)
+               (title #f)
+               (font "Iosevka")
+               (font-size 11))
+  (let ((plots (if (list? plots) plots `(,plots))))
+    (if (not (apply = (map (lambda (plot) (length (plot 'x))) plots)))
+        (error "Length of plots is not equal")
+        (let* ((file-port (mkstemp "/tmp/plot-data-XXXXXX" "w"))
+               (file-name (port-filename file-port)))
+
+          ;; Write data to temporary file
+          (with-output-to-port file-port
+            (lambda ()
+              (for-each
+               (cut >> <>)
+               (map (lambda (sample) (string-join (map
+                                              (lambda (x) (number->string
+                                                      (exact->inexact x)))
+                                              sample) " "))
+                    (apply zip (cons ((first plots) 'x)
+                                     (map (lambda (plot) (plot 'y)) plots)))))))
+          (close-port file-port)
+
+          ;; Call gnuplot
+          (with-output-to-spawn
+           "gnuplot"
+           (lambda ()
+             (>> "set term x11 enhanced font '~a,~a' persist size 640,480" font font-size)
+             ;; (>> "set output '~a'"                                                "draw.png")
+             (>> "set grid")
+             (when xlabel (>> "set xlabel '~a'" xlabel))
+             (when ylabel (>> "set ylabel '~a'" ylabel))
+             (when title  (>> "set title '~a'" title))
+             (>> "plot ~a"
+                 (string-join
+                  (map (lambda (plot n)
+                         (format #f "'~a' using 1:~a with ~a~a"
+                                 file-name
+                                 n
+                                 (plot 'with)
+                                 (if (plot 'title)
+                                     (format #f " title '~a'" (plot 'title))
+                                     "")))
+                       plots
+                       (iota (length plots) 2))
+                  ",\\\n"))))
+
+          ;; Delete temporary file
+          (delete-file file-name)))))
+
+
+;; (define (main args)
+;;   (plot
+;;    `(,(make-plot-xy
+;;        #:x (iota 17 20 -1)
+;;        #:y '(1 2 3 4 3 2 1 0 -1 -2 -3 -4 -3 -2 -1 0 1)
+;;        #:title "plot A"
+;;        #:with "lines lw 2")
+
+;;      ,(make-plot-xy
+;;        #:x (iota 17 20 -1)
+;;        #:y (map (cut * -0.5 <>) '(1 2 3 4 3 2 1 0 -1 -2 -3 -4 -3 -2 -1 0 1))
+;;        #:title "plot B"
+;;        #:with "lines"))))

embddr/vcd.scm

@@ -123,8 +123,9 @@
 ;;;
 ;;; Parse VCD header
 ;;; Returns values of timescale and association list (tag . (<signal> ...))
+;;; Predicate: (need-signal? <signal>)
 ;;;
-(define (read-header port)
+(define* (read-header port need-signal?)
   (let next-cmd ((timescale #f)
                  (scope '())
                  (tags+signals '()))
@@ -138,6 +139,7 @@
              ((string-ci= name "$timescale")
               (next-cmd (parse-timescale (second cmd)) scope tags+signals))
 
+             ;; TODO: Add scope type (make scope as pair '(scope-type . scope-name))
              ((string-ci= name "$scope")
               (next-cmd timescale (cons (third cmd) scope) tags+signals))
 
@@ -149,18 +151,20 @@
                            (else 'bits)))
                     (width (string->number (third cmd)))
                     (tag (fourth cmd))
-                    (vname (string-concatenate
-                            (insert-between
-                             (cddddr cmd) " "))))
+                    (name (string-concatenate
+                           (insert-between
+                            (cddddr cmd) " "))))
                 (next-cmd timescale scope
-                          (let ((tag+sig (assoc tag tags+signals))
-                                (sig (signal-new (reverse scope)
-                                                 vname type width '())))
-                            (if tag+sig
-                                (begin
-                                  (set-cdr! tag+sig (cons sig (cdr tag+sig)))
-                                  tags+signals)
-                                (cons (cons tag `(,sig)) tags+signals))))))
+                          (let ((sig (signal-new (reverse scope)
+                                                 name type width '())))
+                            (if (need-signal? sig)
+                                (let ((tag+sig (assoc tag tags+signals)))
+                                  (if tag+sig
+                                      (begin
+                                        (set-cdr! tag+sig (cons sig (cdr tag+sig)))
+                                        tags+signals)
+                                      (cons (cons tag `(,sig)) tags+signals)))
+                                tags+signals)))))
 
              ((string-ci= "$upscope" (first cmd))
               (next-cmd timescale (cdr scope) tags+signals))
@@ -258,7 +262,7 @@
 
                            ;; Update register values list
                            (let ((sigs (hash-table-ref/default tags+signals-ht tag #f)))
-                             (unless (null? sigs)
+                             (when sigs
                                (for-each
                                 (lambda (sig)
                                   (signal-add!
@@ -299,9 +303,9 @@
 ;;; Parse whole VCD
 ;;; Returns list of time stamps and list of lists (<signal> valuse ...)
 ;;;
-(define (vcd-parse port)
+(define* (vcd-parse port #:optional (need-signal? (lambda (s) #t)))
   (call-with-values
-      (lambda () (read-header port))
+      (lambda () (read-header port need-signal?))
     (cut read-data port <...>)))
 
 ;;;