57 lines
1.1 KiB
Scheme
57 lines
1.1 KiB
Scheme
(use-modules (graphgif)
|
|
(srfi srfi-1))
|
|
|
|
(define red (create-color 1 0 0))
|
|
|
|
(define my-graph
|
|
`(((10 . 10) (1))
|
|
((30 . 20) () ,red)))
|
|
|
|
(define more-complex-graph
|
|
`(((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))
|
|
|
|
(define (idx->y i w)
|
|
(quotient i w))
|
|
|
|
(define (xy->idx x y w)
|
|
(+ (* y w) x))
|
|
|
|
(define (idx->edges i w)
|
|
(filter-map
|
|
(lambda (offset)
|
|
(let* ([x (idx->x i w)]
|
|
[y (idx->y i w)]
|
|
[ox (+ x (car offset))]
|
|
[oy (+ y (cdr offset))])
|
|
(and
|
|
(not (negative? ox))
|
|
(not (negative? oy))
|
|
(< ox w)
|
|
(xy->idx ox oy w))))
|
|
;; Auto-connect these directions if legal indices
|
|
'(( 0 . -1)
|
|
(-1 . 0)
|
|
(-1 . -1)
|
|
(+1 . -1))))
|
|
|
|
(define (generate-web w h)
|
|
(define (make-node i)
|
|
(list
|
|
(cons (+ (* 30 (idx->x i w)) 10)
|
|
(+ (* 30 (idx->y i w)) 10))
|
|
(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 10 10) "graph.gif")
|