Use records instead of conss for nodes, alist for graphs

cgif.scm

@@ -1,5 +0,0 @@
-(define-module (cgif)
-  #:use-module (cgif config)
-  #:export (make-gif))
-
-(load-extension (in-vicinity installdir "libguilecgif") "init_cgif")

cgif/Makefile

@@ -1,14 +0,0 @@
-INSTALL = $(PWD)
-CFLAGS = `pkg-config --cflags guile-cairo cgif`
-LIBS = `pkg-config --libs guile-cairo cgif`
-
-all: libguilecgif.so config.scm
-
-libguilecgif.so: guile-cgif.c
-	$(CC) $(CFLAGS) -shared -fPIC -o $@ $^ $(LIBS)
-
-config.scm: config.scm.in
-	sed 's|INSTALLDIR|$(INSTALL)|' < $< > $@
-
-clean:
-	rm -rf libguilecgif.so config.scm

cgif/config.scm.in

@@ -1,4 +0,0 @@
-(define-module (cgif config)
-  #:export (installdir))
-
-(define installdir "INSTALLDIR")

cgif/guile-cgif.c

@@ -1,80 +0,0 @@
-#include <stdlib.h>
-#include <string.h>
-#include <guile-cairo.h>
-#include <cgif.h>
-
-
-const uint8_t PALETTE[] = {
-  0xFF, 0xFF, 0xFF, // WHITE
-  0x00, 0x00, 0x00, // BLACK
-  0xFF, 0x00, 0x00  // RED
-};
-
-#define CAIRO_RED   0x00FF0000
-#define CAIRO_BLACK 0x00000000
-
-void encode_frame(cairo_surface_t *surface, CGIF_FrameConfig *frameconfig) {
-  // TODO pull colors from cairo
-  size_t size = cairo_image_surface_get_width(surface) * cairo_image_surface_get_height(surface);
-  frameconfig->pLocalPalette = (uint8_t*) &PALETTE;
-  frameconfig->numLocalPaletteEntries = 3;
-  frameconfig->pImageData = (uint8_t*)calloc(size, sizeof(uint8_t));
-
-  if (cairo_image_surface_get_format(surface) == CAIRO_FORMAT_RGB24) {
-    uint32_t* pen = (uint32_t*) cairo_image_surface_get_data(surface);
-    for (size_t i = 0; i < size; i++) {
-      uint32_t cairo_color = pen[i];
-      switch (cairo_color & 0x00FFFFFF) {
-      case CAIRO_BLACK:
-	frameconfig->pImageData[i] = 1;
-	break;
-      case CAIRO_RED:
-	frameconfig->pImageData[i] = 2;
-	break;
-      }
-    }
-  }
-}
-
-void make_gif_inner(cairo_surface_t *frames[], size_t n_frames, const char* path) {
-  CGIF_Config cgif_config;
-  memset(&cgif_config, 0, sizeof(CGIF_Config));
-  cgif_config.path = path;
-  cgif_config.attrFlags = CGIF_ATTR_IS_ANIMATED | CGIF_ATTR_NO_GLOBAL_TABLE;
-  cgif_config.width = cairo_image_surface_get_width(frames[0]);
-  cgif_config.height = cairo_image_surface_get_height(frames[0]);
-
-  CGIF *cgif = cgif_newgif(&cgif_config);
-
-  for (size_t i = 0; i < n_frames; i++) {
-    cairo_surface_t *frame = frames[i];
-    // Flush pending writes
-    cairo_surface_flush(frame);
-
-    CGIF_FrameConfig cgif_frameconfig;
-    memset(&cgif_frameconfig, 0, sizeof(CGIF_FrameConfig));
-    cgif_frameconfig.attrFlags = CGIF_FRAME_ATTR_USE_LOCAL_TABLE;
-    cgif_frameconfig.delay = 100;
-
-    encode_frame(frame, &cgif_frameconfig);
-    cgif_addframe(cgif, &cgif_frameconfig);
-  }
-
-  cgif_close(cgif);
-}
-
-SCM make_gif(SCM frames, SCM path) {
-  size_t n_frames = scm_to_size_t(scm_length(frames));
-  cairo_surface_t **c_frames = (cairo_surface_t **) malloc(sizeof(cairo_surface_t*) * n_frames);
-  for (size_t i = 0; i < n_frames; i++) {
-    c_frames[i] = scm_to_cairo_surface(scm_list_ref(frames, scm_from_size_t(i)));
-  }
-  const char* c_path = scm_to_locale_string(path);
-
-  make_gif_inner(c_frames, n_frames, c_path);
-  return SCM_UNSPECIFIED;
-}
-
-void init_cgif() {
-  scm_c_define_gsubr("make-gif", 2, 0, 0, &make_gif);
-}

demo.scm

@@ -1,19 +1,10 @@
-(use-modules (graphgif))
+(use-modules (graphgif)
+	     (srfi srfi-9 gnu)
+	     (ice-9 copy-tree))
 
 (define red (create-color 1 0 0))
 
-(define my-graph
+(define graph1 (generate-web 10 10))
-  `(((10 . 10) (1))
+(define graph2 (copy-tree graph1))
-    ((30 . 20) () ,red)))
+(assq-set! graph2 0 (set-node-color (assq-ref graph2 0) red))
-
+(write-graphs-to-file (list graph1 graph2) "graph.gif")
-(define more-complex-graph
-  `(((10 . 10) ()) 
-    ((40 . 10) (0))
-    ((25 . 25) (0 1))
-    ((10 . 40) (0 2 4))
-    ((40 . 40) (1 2 3))))
-
-(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"))

graphgif.scm

@@ -1,8 +1,8 @@
 (define-module (graphgif))
 
 (use-modules (cairo)
-	     (cgif)
+	     (srfi srfi-1)
-	     (srfi srfi-1))
+	     (srfi srfi-9 gnu))
 
 (re-export (cairo-pattern-create-rgb . create-color))
 
@@ -16,17 +16,28 @@
 (define-public black (cairo-pattern-create-rgb 0 0 0))
 (define-public white (cairo-pattern-create-rgb 1 1 1))
 
+(define-immutable-record-type <node>
+  (node coords edges color)
+  node?
+  (coords node-coords set-node-coords)
+  (edges node-edges set-node-edges)
+  (color node-color set-node-color))
+(export node node?
+	node-coords set-node-coords
+	node-edges set-node-edges
+	node-color set-node-color)
+
 (define (edge-painter cr graph)
   (lambda (node)
     (cairo-set-source cr black)
-    (let ([x (caar node)]
+    (let ([x (car (node-coords node))]
-	  [y (cdar node)]
+	  [y (cdr (node-coords node))]
-	  [edges (cadr node)])
+	  [edges (node-edges node)])
       (for-each
        (lambda (edge)
-	 (let* ([other (list-ref graph edge)]
+	 (let* ([other (assq-ref graph edge)]
-		[ox (caar other)]
+		[ox (car (node-coords other))]
-		[oy (cdar other)])
+		[oy (cdr (node-coords other))])
 	   (cairo-move-to cr x y)
 	   (cairo-line-to cr ox oy)
 	   (cairo-stroke cr)))
@@ -34,11 +45,9 @@
 
 (define (node-painter cr)
   (lambda (node)
-    (let ([x (caar node)]
+    (let ([x (car (node-coords node))]
-	  [y (cdar node)]
+	  [y (cdr (node-coords node))]
-	  [color (if (null? (cddr node))
+	  [color (or (node-color node) white)])
-		     white
-		     (caddr node))])
       (cairo-arc cr x y 4. 0. tau)
       (cairo-set-source cr color)
       (cairo-fill-preserve cr)
@@ -54,16 +63,11 @@
     (cairo-rectangle cr 0 0 400 400)
     (cairo-set-source cr white)
     (cairo-fill cr)
-    (for-each paint-edges graph)
+    (for-each paint-edges (map cdr graph))
-    (for-each paint-nodes graph)
+    (for-each paint-nodes (map cdr graph))
     (cairo-destroy cr)
     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 ;;
 ;;;;;;;;;;;;;;;;;;;;;;
@@ -97,16 +101,35 @@
 
 (define-public (generate-web w h)
   (define (make-node i)
-    (list
+    (cons i
+	  (node
 	   (cons (+ (* 30 (idx->x i w)) 10)
 		 (+ (* 30 (idx->y i w)) 10))
-     (idx->edges i w)))
+	   (idx->edges i w)
+	   #f)))
   (let loop ([i 0]
 	     [lst '()])
     (if (>= i (* w h))
 	(reverse lst)
 	(loop (1+ i) (cons (make-node i) lst)))))
 
+;;;;;;;;;;;;
+;; Output ;;
+;;;;;;;;;;;;
+
+(define (output-to-file surfaces filename)
+  (define pngdir (mkdtemp "/tmp/graphgif_XXXXXX"))
+  (do ([i 1 (1+ i)]
+       [surfaces surfaces (cdr surfaces)])
+      ((null? surfaces))
+    (cairo-surface-write-to-png
+     (car surfaces)
+     (string-append pngdir "/img-" (number->string i) ".png")))
+  (system* "ffmpeg" "-i" (string-append pngdir "/img-%d.png") "-r" "1" filename))
+
+(define-public (write-graphs-to-file graphs filename)
+  (output-to-file (map draw-abstract-graph graphs) filename))
+
 ;; Local Variables:
 ;; geiser-scheme-implementation: guile
 ;; End: