Draw large web

demo.scm

@@ -0,0 +1,52 @@
+(use-modules (graphgif)
+	     (srfi srfi-1))
+
+(define my-graph
+  `(((10 . 10) (1) ,white)
+    ((30 . 20) ()  ,red)))
+
+(define more-complex-graph
+  `(((10 . 10) () ,white) 
+    ((40 . 10) (0) ,white)
+    ((25 . 25) (0 1) ,white)
+    ((10 . 40) (0 2 4) ,white)
+    ((40 . 40) (1 2 3) ,white)))
+
+(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 (x y)
+     (if (or (negative? (+ (idx->x i w) x))
+	     (negative? (+ (idx->y i w) y))
+	     (>= (+ (idx->x i w) x) w))
+	 #f
+	 (xy->idx
+	  (+ (idx->x i w) x)
+	  (+ (idx->y i w) y)
+	  w)))
+   '(+0 -1 -1 +1)
+   '(-1 +0 -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)
+     white))
+  (reverse
+   (let loop ([i 0]
+	      [lst '()])
+     (if (>= i (* w h))
+	 lst
+	 (loop (1+ i) (cons (make-node i) lst))))))
+
+(write-graph-to-file (generate-web 5 5) (cadr (command-line)))

graphgif.scm

@@ -1,28 +1,17 @@
-#!/usr/bin/guile -s
+(define-module (graphgif))
-!#
+
 (use-modules (cairo))
 
 ;;;;;;;;;;;;;;;;;;;
 ;; Basic Drawing ;;
 ;;;;;;;;;;;;;;;;;;;
 
-(define pi 3.14159)
+(define-public pi 3.14159)
-(define tau (* 2 pi))
+(define-public tau (* 2 pi))
 
-(define black (cairo-pattern-create-rgb 0 0 0))
+(define-public black (cairo-pattern-create-rgb 0 0 0))
-(define white (cairo-pattern-create-rgb 1 1 1))
+(define-public white (cairo-pattern-create-rgb 1 1 1))
-(define red   (cairo-pattern-create-rgb 1 0 0))
+(define-public red   (cairo-pattern-create-rgb 1 0 0))
-
-(define my-graph
-  `(((10 . 10) (1) ,white)
-    ((30 . 20) ()  ,red)))
-
-(define more-complex-graph
-  `(((10 . 10) () ,white) 
-    ((40 . 10) (0) ,white)
-    ((25 . 25) (0 1) ,white)
-    ((10 . 40) (0 2 4) ,white)
-    ((40 . 40) (1 2 3) ,white)))
 
 (define (edge-painter cr graph)
   (lambda (node)
@@ -51,7 +40,7 @@
       (cairo-set-source cr black)
       (cairo-stroke cr))))
 
-(define (draw-abstract-graph graph)
+(define-public (draw-abstract-graph graph)
   (let* ([surface (cairo-image-surface-create 'argb32 400 400)]
 	 [cr (cairo-create surface)])
     (define paint-edges (edge-painter cr graph))
@@ -65,9 +54,11 @@
     (cairo-destroy cr)
     surface))
 
-(define my-surface (draw-abstract-graph more-complex-graph))
+(define-public (write-graph-to-file graph filename)
-(cairo-surface-write-to-png my-surface (cadr (command-line)))
+  (define my-surface (draw-abstract-graph graph))
-(cairo-surface-destroy my-surface)
+  (cairo-surface-write-to-png my-surface filename)
+  (cairo-surface-destroy my-surface))
+
 
 ;; Local Variables:
 ;; geiser-scheme-implementation: guile

run.sh

@@ -4,6 +4,6 @@ GRAPH_FILE=/tmp/graph.png
 
 set -e
 
-guile graphgif.scm $GRAPH_FILE
+guile -L . demo.scm $GRAPH_FILE
 feh $GRAPH_FILE
 rm $GRAPH_FILE