#!/usr/bin/guile -s
!#
(use-modules (cairo))

;;;;;;;;;;;;;;;;;;;
;; Basic Drawing ;;
;;;;;;;;;;;;;;;;;;;

(define pi 3.14159)
(define tau (* 2 pi))

(define black (cairo-pattern-create-rgb 0 0 0))
(define white (cairo-pattern-create-rgb 1 1 1))
(define 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)
  (lambda (node)
    (cairo-set-source cr black)
    (let ([x (caar node)]
	  [y (cdar node)]
	  [edges (cadr node)])
      (for-each
       (lambda (edge)
	 (let* ([other (list-ref graph edge)]
		[ox (caar other)]
		[oy (cdar other)])
	   (cairo-move-to cr x y)
	   (cairo-line-to cr ox oy)
	   (cairo-stroke cr)))
       edges))))

(define (node-painter cr)
  (lambda (node)
    (let ([x (caar node)]
	  [y (cdar node)]
	  [color (caddr node)])
      (cairo-arc cr x y 4. 0. tau)
      (cairo-set-source cr color)
      (cairo-fill-preserve cr)
      (cairo-set-source cr black)
      (cairo-stroke cr))))

(define (draw-abstract-graph graph)
  (let* ([surface (cairo-image-surface-create 'argb32 400 400)]
	 [cr (cairo-create surface)])
    (define paint-edges (edge-painter cr graph))
    (define paint-nodes (node-painter cr))
    ;; White background
    (cairo-rectangle cr 0 0 400 400)
    (cairo-set-source cr white)
    (cairo-fill cr)
    (for-each paint-edges graph)
    (for-each paint-nodes graph)
    (cairo-destroy cr)
    surface))

(define my-surface (draw-abstract-graph more-complex-graph))
(cairo-surface-write-to-png my-surface "graph.png")
(cairo-surface-destroy my-surface)

;; Local Variables:
;; geiser-scheme-implementation: guile
;; End: