From 0c0142881f769b6c42a8a69bec490ba9e98ccf48 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Fri, 23 Sep 2022 21:01:17 +0200
Subject: Move all generally usable scripts to module dir.

---
 scripts/use2dot/gen-use.scm | 141 --------------------------------------------
 1 file changed, 141 deletions(-)
 delete mode 100755 scripts/use2dot/gen-use.scm

(limited to 'scripts/use2dot')

diff --git a/scripts/use2dot/gen-use.scm b/scripts/use2dot/gen-use.scm
deleted file mode 100755
index 6c621fdd..00000000
--- a/scripts/use2dot/gen-use.scm
+++ /dev/null
@@ -1,141 +0,0 @@
-#!/usr/bin/guile -s
-!#
-
-(add-to-load-path (dirname (current-filename)))
-(add-to-load-path (dirname (dirname (current-filename))))
-
-(use-modules ((scripts frisk) :select (make-frisker edge-type edge-up
-                              edge-down))
-             (srfi srfi-1)
-             ((graphviz) :prefix gv.)
-             (all-modules)
-             )
-
-(define scan (make-frisker `(default-module . (calp main))))
-
-(define-values (files our-modules)
-  (all-modules-under-directory "module"))
-
-(define graph (gv.digraph "G"))
-(gv.setv graph "color" "blue")
-(gv.setv graph "compound" "true")
-(gv.setv graph "overlap" "prism")
-;; (gv.setv graph "bgcolor" "blue")
-
-(define count 0)
-
-(define colors
-  '("red" "green" "blue"))
-
-(define rem our-modules)
-
-;; (for-each (lambda (key)
-;; 
-;;             (define subgraph (gv.graph graph (format #f "cluster_~a" count)))
-;; 
-;;             (define-values (use rem*) (partition (lambda (mod) (eq? key (car mod))) rem))
-;;             (set! rem rem*)
-;; 
-;;             ;; (gv.setv subgraph "rankdir" "TB")
-;;             (gv.setv subgraph "color" (list-ref colors count))
-;; 
-;;             (for-each (lambda (name)
-;;                         (gv.node subgraph (format #f "~a" name)))
-;;                       use)
-;; 
-;;             (set! count (1+ count))
-;;             )
-;;           '(calp vcomponent))
-
-;; (define subgraph (gv.graph graph (format #f "cluster_~a" count)))
-;; 
-;; ;; (gv.setv subgraph "rankdir" "TB")
-;; (gv.setv subgraph "color" (list-ref colors count))
-;; 
-;; (for-each (lambda (name)
-;;             (gv.node subgraph (format #f "~a" name)))
-;;           rem)
-
-(define subgraph (gv.graph graph (format #f "cluster_~a" 0)))
-
-;; (gv.setv subgraph "rankdir" "TB")
-(gv.setv subgraph "color" "Red")
-
-(define subgraphs (make-hash-table))
-
-(for-each (lambda (name)
-            (let ((g (hashq-ref subgraphs (car name)
-                                (gv.graph graph (format #f "cluster_~a" (car name))))))
-              (hashq-set! subgraphs (car name) g)
-
-              (let ((node (gv.node g (format #f "~a" name))))
-                (gv.setv node "fillcolor" "green")
-                (gv.setv node "style" "filled")
-                ))
-            )
-          (remove (lambda (x) (eq? 'calp (car x)))
-                  our-modules))
-
-
-(define calp-base (gv.graph graph "cluster_1"))
-(define calpgraphs (make-hash-table))
-
-(for-each (lambda (name)
-            (let ((g (hashq-ref calpgraphs (cadr name)
-                                (gv.graph 
-                                  ;; calp-base 
-                                  graph
-                                  (format #f "cluster_~a" (cadr name))))))
-              (hashq-set! calpgraphs (car name) g)
-
-              (let ((node (gv.node g (format #f "~a" name))))
-                (gv.setv node "fillcolor" "green")
-                (gv.setv node "style" "filled")
-                ))
-            )
-          (remove (compose null? cdr)
-                  (filter (lambda (x) (eq? 'calp (car x)))
-                          our-modules)))
-
-
-(define (remove-edges blacklist edges)
-  (remove (lambda (edge)
-            (or (member (edge-up edge) blacklist)
-                (member (edge-down edge) blacklist)))
-          edges))
-
-
-
-
-
-(for-each (lambda (edge)
-            (let ((gv-edge (gv.edge graph
-                                 (format #f "~a" (edge-down edge))
-                                 (format #f "~a" (edge-up edge))
-                                 )))
-              (when (and (eq? 'calp (car (edge-up edge)))
-                         (not (eq? 'calp (car (edge-down edge)))))
-                (gv.setv gv-edge "color" "red"))
-              (when (and (memv (car (edge-up edge)) '(vcomponent calp))
-                         (not (memv (car (edge-down edge)) '(vcomponent calp ))))
-                (gv.setv gv-edge "color" "blue"))
-              ))
-          (remove-edges '((srfi srfi-1)
-                          (srfi srfi-9)
-                          (srfi srfi-26)
-                          (srfi srfi-41)
-
-                          (ice-9 match)
-                          (ice-9 format)
-
-                          (datetime)
-                          (vcomponent)
-                          (hnh util)
-                          )
-                        ((scan files) 'edges)))
-
-(gv.layout graph "fdp")
-(gv.render graph "pdf" "graph.pdf")
-
-
-(display "done\n")
-- 
cgit v1.2.3