diff --git a/demo.scm b/demo.scm index 3b92ddb..7d2824a 100644 --- a/demo.scm +++ b/demo.scm @@ -19,13 +19,11 @@ (cdr pair)))) graph)) -(define* (heap-unfold heap #:optional (infinites? #f)) - (if (and (heap-peek heap) (or infinites? (finite? (car (heap-peek heap))))) - (cons (heap-peek heap) (heap-unfold (heap-pop heap) infinites?)) - '())) - -(define graphs '()) -(djikstra graph 90 9 (lambda (visited heap) - (set! graphs (cons (color-graph graph visited heap) graphs)))) -(write-graphs-to-file (reverse-list->vector graphs) "djikstra.webp") +(define graph-generator + (make-generator + (lambda (yield) + (djikstra graph 90 9 (lambda (visited heap) + (yield (color-graph graph visited heap)))) + #f))) +(write-graphs-to-file "djikstra.webp" graph-generator) diff --git a/graphgif.scm b/graphgif.scm index 0defe00..557121f 100644 --- a/graphgif.scm +++ b/graphgif.scm @@ -241,21 +241,24 @@ ;; Output ;; ;;;;;;;;;;;; -(define (output-to-file surfaces filename) +(define (output-to-file filename surface-gen) (define pngdir (mkdtemp "/tmp/graphgif_XXXXXX")) - (vector-for-each - (lambda (i surface) - (cairo-surface-write-to-png - surface - (string-append pngdir "/img-" (number->string i) ".png"))) - surfaces) + (let loop ([surface (surface-gen)] + [i 1]) + (when surface + (cairo-surface-write-to-png + surface + (string-append pngdir "/img-" (number->string i) ".png")) + (loop (surface-gen) (1+ i)))) (system* "ffmpeg" "-y" "-i" (string-append pngdir "/img-%d.png") "-loop" "0" filename)) -(define-public (write-graphs-to-file graphs filename) - (output-to-file (vector-map (lambda (_ graph) (draw-abstract-graph graph)) graphs) - filename)) +(define-public (write-graphs-to-file filename graph-gen) + (define (surface-gen) + (let ([graph (graph-gen)]) + (and graph (draw-abstract-graph graph)))) + (output-to-file filename surface-gen)) ;; Local Variables: ;; geiser-scheme-implementation: guile