From 31f4707fbfb43e6dc67dd902429abb119cbf8a26 Mon Sep 17 00:00:00 2001
From: Dane Johnson <daneallenjohnson@protonmail.com>
Date: Tue, 22 Oct 2024 08:51:33 -0500
Subject: [PATCH] Remove a section of the web

---
 demo.scm     |  2 +-
 graphgif.scm | 22 ++++++++++++++++++++++
 2 files changed, 23 insertions(+), 1 deletion(-)

diff --git a/demo.scm b/demo.scm
index 6e52074..e49b0e5 100644
--- a/demo.scm
+++ b/demo.scm
@@ -5,6 +5,6 @@
 (define red (create-color 1 0 0))
 
 (define graph1 (generate-web 10 10))
-(define graph2 (copy-tree graph1))
+(define graph2 (remove-rect (copy-tree graph1) 10 3 3 4 5))
 (assq-set! graph2 0 (set-node-color (assq-ref graph2 0) red))
 (write-graphs-to-file (list graph1 graph2) "graph.gif")
diff --git a/graphgif.scm b/graphgif.scm
index 2ee0759..f69b7e8 100644
--- a/graphgif.scm
+++ b/graphgif.scm
@@ -113,6 +113,28 @@
 	(reverse lst)
 	(loop (1+ i) (cons (make-node i) lst)))))
 
+(define-public (remove-rect graph w x1 y1 x2 y2)
+  ;; Assumption is that is a graph generated by generate-web
+  ;; and that it has not been re-indexed
+  ;; x1 < x2, y1 < y2
+  (define edges-to-remove
+    (unfold (lambda (s) (> s (xy->idx x2 y2 w)))
+	    identity
+	    (lambda (s) (if (>= (idx->x s w) x2)
+			    (xy->idx x1 (1+ (idx->y s w)) w)
+			    (1+ s)))
+	    (xy->idx x1 y1 w)))
+  (filter-map
+   (lambda (idx/node)
+     (if (memq (car idx/node) edges-to-remove)
+	 #f
+	 (cons (car idx/node)
+	       (set-node-edges (cdr idx/node)
+			       (remove
+				(lambda (edge) (memq edge edges-to-remove))
+				(node-edges (cdr idx/node)))))))
+   graph))
+
 ;;;;;;;;;;;;
 ;; Output ;;
 ;;;;;;;;;;;;