Make graphgif a library, demo.scm is driver
This commit is contained in:
parent
62fa492823
commit
6b11d25df2
14
demo.scm
Normal file
14
demo.scm
Normal file
@ -0,0 +1,14 @@
|
|||||||
|
(use-modules (graphgif))
|
||||||
|
|
||||||
|
(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)))
|
||||||
|
|
||||||
|
(write-graph-to-file more-complex-graph (cadr (command-line)))
|
35
graphgif.scm
35
graphgif.scm
@ -1,28 +1,17 @@
|
|||||||
#!/usr/bin/guile -s
|
(define-module (graphgif))
|
||||||
!#
|
|
||||||
(use-modules (cairo))
|
(use-modules (cairo))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;
|
||||||
;; Basic Drawing ;;
|
;; 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)
|
(define (edge-painter cr graph)
|
||||||
(lambda (node)
|
(lambda (node)
|
||||||
@ -51,7 +40,7 @@
|
|||||||
(cairo-set-source cr black)
|
(cairo-set-source cr black)
|
||||||
(cairo-stroke cr))))
|
(cairo-stroke cr))))
|
||||||
|
|
||||||
(define (draw-abstract-graph graph)
|
(define-public (draw-abstract-graph graph)
|
||||||
(let* ([surface (cairo-image-surface-create 'argb32 400 400)]
|
(let* ([surface (cairo-image-surface-create 'argb32 400 400)]
|
||||||
[cr (cairo-create surface)])
|
[cr (cairo-create surface)])
|
||||||
(define paint-edges (edge-painter cr graph))
|
(define paint-edges (edge-painter cr graph))
|
||||||
@ -65,9 +54,11 @@
|
|||||||
(cairo-destroy cr)
|
(cairo-destroy cr)
|
||||||
surface))
|
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:
|
;; Local Variables:
|
||||||
;; geiser-scheme-implementation: guile
|
;; geiser-scheme-implementation: guile
|
||||||
|
Loading…
Reference in New Issue
Block a user