From 4569ddfb1a6b30f6567e42b8be329792dbd3f37b Mon Sep 17 00:00:00 2001
From: Dane Johnson <daneallenjohnson@protonmail.com>
Date: Fri, 18 Oct 2024 10:23:46 -0500
Subject: [PATCH] More stuff fuckit

---
 demo.scm     | 47 +++++-----------------------------------------
 graphgif.scm | 53 +++++++++++++++++++++++++++++++++++++++++++++++-----
 2 files changed, 53 insertions(+), 47 deletions(-)

diff --git a/demo.scm b/demo.scm
index 3507940..57dbdae 100644
--- a/demo.scm
+++ b/demo.scm
@@ -1,5 +1,4 @@
-(use-modules (graphgif)
-	     (srfi srfi-1))
+(use-modules (graphgif))
 
 (define red (create-color 1 0 0))
 
@@ -14,43 +13,7 @@
     ((10 . 40) (0 2 4))
     ((40 . 40) (1 2 3))))
 
-(define (idx->x i w)
-  (modulo i w))
-
-(define (idx->y i w)
-  (quotient i w))
-
-(define (xy->idx x y w)
-  (+ (* y w) x))
-
-(define (idx->edges i w)
-  (filter-map
-   (lambda (offset)
-     (let* ([x (idx->x i w)]
-	    [y (idx->y i w)]
-	    [ox (+ x (car offset))]
-	    [oy (+ y (cdr offset))])
-       (and
-	(not (negative? ox))
-	(not (negative? oy))
-	(< ox w)
-	(xy->idx ox oy w))))
-   ;; Auto-connect these directions if legal indices
-   '(( 0 . -1)
-     (-1 .  0)
-     (-1 . -1)
-     (+1 . -1))))
-
-(define (generate-web w h)
-  (define (make-node i)
-    (list
-     (cons (+ (* 30 (idx->x i w)) 10)
-	   (+ (* 30 (idx->y i w)) 10))
-     (idx->edges i w)))
-  (let loop ([i 0]
-	     [lst '()])
-    (if (>= i (* w h))
-	(reverse lst)
-	(loop (1+ i) (cons (make-node i) lst)))))
-
-(write-graph-to-file (generate-web 10 10) "graph.gif")
+(let* ([graph1 (generate-web 10 10)]
+       [graph2 (list-copy graph1)])
+  (set-car! graph2 (append (car graph2) `(,red)))
+  (write-graphs-to-file (list graph1 graph2) "graph.gif"))
diff --git a/graphgif.scm b/graphgif.scm
index 36eb38a..3a0cc1d 100644
--- a/graphgif.scm
+++ b/graphgif.scm
@@ -1,7 +1,8 @@
 (define-module (graphgif))
 
 (use-modules (cairo)
-	     (cgif))
+	     (cgif)
+	     (srfi srfi-1))
 
 (re-export (cairo-pattern-create-rgb . create-color))
 
@@ -58,11 +59,53 @@
     (cairo-destroy cr)
     surface))
 
-(define-public (write-graph-to-file graph filename)
-  (define my-surface (draw-abstract-graph graph))
-  (make-gif `(,my-surface) filename)
-  (cairo-surface-destroy my-surface))
+(define-public (write-graphs-to-file graphs filename)
+  (let ([surfaces (map draw-abstract-graph graphs)])
+    (make-gif surfaces filename)
+    (for-each (lambda (s) (cairo-surface-destroy s)) surfaces)))
 
+;;;;;;;;;;;;;;;;;;;;;;
+;; Graph Generation ;;
+;;;;;;;;;;;;;;;;;;;;;;
+
+(define (idx->x i w)
+  (modulo i w))
+
+(define (idx->y i w)
+  (quotient i w))
+
+(define (xy->idx x y w)
+  (+ (* y w) x))
+
+(define (idx->edges i w)
+  (filter-map
+   (lambda (offset)
+     (let* ([x (idx->x i w)]
+	    [y (idx->y i w)]
+	    [ox (+ x (car offset))]
+	    [oy (+ y (cdr offset))])
+       (and
+	(not (negative? ox))
+	(not (negative? oy))
+	(< ox w)
+	(xy->idx ox oy w))))
+   ;; Auto-connect these directions if legal indices
+   '(( 0 . -1)
+     (-1 .  0)
+     (-1 . -1)
+     (+1 . -1))))
+
+(define-public (generate-web w h)
+  (define (make-node i)
+    (list
+     (cons (+ (* 30 (idx->x i w)) 10)
+	   (+ (* 30 (idx->y i w)) 10))
+     (idx->edges i w)))
+  (let loop ([i 0]
+	     [lst '()])
+    (if (>= i (* w h))
+	(reverse lst)
+	(loop (1+ i) (cons (make-node i) lst)))))
 
 ;; Local Variables:
 ;; geiser-scheme-implementation: guile