dane/graphgif
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Code cleanup

Browse Source
This commit is contained in:
Dane Johnson 2024-10-11 17:57:45 -05:00
parent 9e8cf71d3b
commit da71b1bd85
2 changed files with 19 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.#demo.scm
View File

@ -1 +0,0 @@
dane@deelite.633:1728402468

36
demo.scm
View File

@ -23,17 +23,20 @@
(define (idx->edges i w) (define (idx->edges i w)
(filter-map (filter-map
(lambda (x y) (lambda (offset)
(if (or (negative? (+ (idx->x i w) x)) (let* ([x (idx->x i w)]
(negative? (+ (idx->y i w) y)) [y (idx->y i w)]
(>= (+ (idx->x i w) x) w)) [ox (+ x (car offset))]
#f [oy (+ y (cdr offset))])
(xy->idx (and
(+ (idx->x i w) x) (not (negative? ox))
(+ (idx->y i w) y) (not (negative? oy))
w))) (< ox w)
'(+0 -1 -1 +1) (xy->idx ox oy w))))
'(-1 +0 -1 -1))) '(( 0 . -1)
(-1 . 0)
(-1 . -1)
(+1 . -1))))
(define (generate-web w h) (define (generate-web w h)
(define (make-node i) (define (make-node i)
@ -42,11 +45,10 @@
(+ (* 30 (idx->y i w)) 10)) (+ (* 30 (idx->y i w)) 10))
(idx->edges i w) (idx->edges i w)
white)) white))
(reverse (let loop ([i 0]
(let loop ([i 0] [lst '()])
[lst '()]) (if (>= i (* w h))
(if (>= i (* w h)) (reverse lst)
lst (loop (1+ i) (cons (make-node i) lst)))))
(loop (1+ i) (cons (make-node i) lst))))))
(write-graph-to-file (generate-web 5 5) (cadr (command-line))) (write-graph-to-file (generate-web 5 5) (cadr (command-line)))