pre-gif re-write

.gitignore

@@ -0,0 +1,2 @@
+*.png
+*.so

Makefile

@@ -0,0 +1,2 @@
+libguilecgif.so: guile-cgif.c
+	$(CC) `pkg-config --cflags cgif cairo guile-3.0` -shared -fPIC -o $@ $^ `pkg-config --libs cgif cairo guile-3.0`

cgif.scm

@@ -0,0 +1,4 @@
+(define-module (cgif)
+  :export (make-gif))
+
+(load-extension "./libguilecgif", "init_cgif")

demo.scm

@@ -1,16 +1,18 @@
 (use-modules (graphgif)
 	     (srfi srfi-1))
 
+(define red (create-color 1 0 0))
+
 (define my-graph
-  `(((10 . 10) (1) ,white)
-    ((30 . 20) ()  ,red)))
+  `(((10 . 10) (1))
+    ((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)))
+  `(((10 . 10) ()) 
+    ((40 . 10) (0))
+    ((25 . 25) (0 1))
+    ((10 . 40) (0 2 4))
+    ((40 . 40) (1 2 3))))
 
 (define (idx->x i w)
   (modulo i w))
@@ -33,6 +35,7 @@
 	(not (negative? oy))
 	(< ox w)
 	(xy->idx ox oy w))))
+   ;; Auto-connect these directions if legal indices
    '(( 0 . -1)
      (-1 .  0)
      (-1 . -1)
@@ -43,12 +46,11 @@
     (list
      (cons (+ (* 30 (idx->x i w)) 10)
 	   (+ (* 30 (idx->y i w)) 10))
-     (idx->edges i w)
-     white))
+     (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 5 5) (cadr (command-line)))
+(write-graph-to-file (generate-web 10 10) (cadr (command-line)))

graphgif.scm

@@ -2,6 +2,8 @@
 
 (use-modules (cairo))
 
+(re-export (cairo-pattern-create-rgb . create-color))
+
 ;;;;;;;;;;;;;;;;;;;
 ;; Basic Drawing ;;
 ;;;;;;;;;;;;;;;;;;;
@@ -11,7 +13,6 @@
 
 (define-public black (cairo-pattern-create-rgb 0 0 0))
 (define-public white (cairo-pattern-create-rgb 1 1 1))
-(define-public red   (cairo-pattern-create-rgb 1 0 0))
 
 (define (edge-painter cr graph)
   (lambda (node)
@@ -33,7 +34,9 @@
   (lambda (node)
     (let ([x (caar node)]
 	  [y (cdar node)]
-	  [color (caddr node)])
+	  [color (if (null? (cddr node))
+		     white
+		     (caddr node))])
       (cairo-arc cr x y 4. 0. tau)
       (cairo-set-source cr color)
       (cairo-fill-preserve cr)

guile-cgif.c

@@ -0,0 +1,77 @@
+#include <stdlib.h>
+#include <libguile.h>
+#include <cgif.h>
+#include <cairo.h>
+
+const uint8_t PALETTE[] = {
+  0xFF, 0xFF, 0xFF, // WHITE
+  0x00, 0x00, 0x00, // BLACK
+  0xFF, 0x00, 0x00  // RED
+};
+
+#define CAIRO_RED 0x00FF0000
+#define CAIRO_BLACK 0x00FFFFFF
+
+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) {
+    unsigned char* pen = cairo_image_surface_get_data(surface);
+    for (size_t i = 0; i < size; i++) {
+      uint32_t cairo_color = (uint32_t)(*(pen + i * sizeof(uint32_t) * cairo_image_surface_get_stride(surface)));
+      switch (cairo_color) {
+      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;
+  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;
+    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);
+}
+
+void make_gif(SCM frames, SCM path) {
+  size_t c_length = scm_c_array_length(frames);
+  scm_t_array_handle c_array;
+  scm_array_get_handle(frames, &c_array);
+  cairo_surface_t **c_frames = scm_array_handle_uniform_elements(&c_array);
+  const char* c_path = scm_to_locale_string(path);
+
+  make_gif_inner(c_frames, c_length, c_path);
+
+  scm_array_handle_release(&c_array);
+}
+
+void init_cgif() {
+  scm_c_define_gsubr("make-gif", 2, 0, 0, &make_gif);
+}