Writer takes a generator, coroutines!
This commit is contained in:
parent
641048b56d
commit
bcdb95211b
16
demo.scm
16
demo.scm
@ -19,13 +19,11 @@
|
|||||||
(cdr pair))))
|
(cdr pair))))
|
||||||
graph))
|
graph))
|
||||||
|
|
||||||
(define* (heap-unfold heap #:optional (infinites? #f))
|
(define graph-generator
|
||||||
(if (and (heap-peek heap) (or infinites? (finite? (car (heap-peek heap)))))
|
(make-generator
|
||||||
(cons (heap-peek heap) (heap-unfold (heap-pop heap) infinites?))
|
(lambda (yield)
|
||||||
'()))
|
(djikstra graph 90 9 (lambda (visited heap)
|
||||||
|
(yield (color-graph graph visited heap))))
|
||||||
(define graphs '())
|
#f)))
|
||||||
(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")
|
|
||||||
|
|
||||||
|
(write-graphs-to-file "djikstra.webp" graph-generator)
|
||||||
|
23
graphgif.scm
23
graphgif.scm
@ -241,21 +241,24 @@
|
|||||||
;; Output ;;
|
;; Output ;;
|
||||||
;;;;;;;;;;;;
|
;;;;;;;;;;;;
|
||||||
|
|
||||||
(define (output-to-file surfaces filename)
|
(define (output-to-file filename surface-gen)
|
||||||
(define pngdir (mkdtemp "/tmp/graphgif_XXXXXX"))
|
(define pngdir (mkdtemp "/tmp/graphgif_XXXXXX"))
|
||||||
(vector-for-each
|
(let loop ([surface (surface-gen)]
|
||||||
(lambda (i surface)
|
[i 1])
|
||||||
(cairo-surface-write-to-png
|
(when surface
|
||||||
surface
|
(cairo-surface-write-to-png
|
||||||
(string-append pngdir "/img-" (number->string i) ".png")))
|
surface
|
||||||
surfaces)
|
(string-append pngdir "/img-" (number->string i) ".png"))
|
||||||
|
(loop (surface-gen) (1+ i))))
|
||||||
(system* "ffmpeg" "-y"
|
(system* "ffmpeg" "-y"
|
||||||
"-i" (string-append pngdir "/img-%d.png")
|
"-i" (string-append pngdir "/img-%d.png")
|
||||||
"-loop" "0" filename))
|
"-loop" "0" filename))
|
||||||
|
|
||||||
(define-public (write-graphs-to-file graphs filename)
|
(define-public (write-graphs-to-file filename graph-gen)
|
||||||
(output-to-file (vector-map (lambda (_ graph) (draw-abstract-graph graph)) graphs)
|
(define (surface-gen)
|
||||||
filename))
|
(let ([graph (graph-gen)])
|
||||||
|
(and graph (draw-abstract-graph graph))))
|
||||||
|
(output-to-file filename surface-gen))
|
||||||
|
|
||||||
;; Local Variables:
|
;; Local Variables:
|
||||||
;; geiser-scheme-implementation: guile
|
;; geiser-scheme-implementation: guile
|
||||||
|
Loading…
Reference in New Issue
Block a user