Draw large web
This commit is contained in:
parent
6b11d25df2
commit
bc61ef7d8f
42
demo.scm
42
demo.scm
@ -1,4 +1,5 @@
|
||||
(use-modules (graphgif))
|
||||
(use-modules (graphgif)
|
||||
(srfi srfi-1))
|
||||
|
||||
(define my-graph
|
||||
`(((10 . 10) (1) ,white)
|
||||
@ -11,4 +12,41 @@
|
||||
((10 . 40) (0 2 4) ,white)
|
||||
((40 . 40) (1 2 3) ,white)))
|
||||
|
||||
(write-graph-to-file more-complex-graph (cadr (command-line)))
|
||||
(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 (x y)
|
||||
(if (or (negative? (+ (idx->x i w) x))
|
||||
(negative? (+ (idx->y i w) y))
|
||||
(>= (+ (idx->x i w) x) w))
|
||||
#f
|
||||
(xy->idx
|
||||
(+ (idx->x i w) x)
|
||||
(+ (idx->y i w) y)
|
||||
w)))
|
||||
'(+0 -1 -1 +1)
|
||||
'(-1 +0 -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)
|
||||
white))
|
||||
(reverse
|
||||
(let loop ([i 0]
|
||||
[lst '()])
|
||||
(if (>= i (* w h))
|
||||
lst
|
||||
(loop (1+ i) (cons (make-node i) lst))))))
|
||||
|
||||
(write-graph-to-file (generate-web 5 5) (cadr (command-line)))
|
||||
|
Loading…
Reference in New Issue
Block a user