@@ -0,0 +1,6 @@ | |||||
# racket svg macros | |||||
simple macros to make generating svg's a little easier. | |||||
`test.svg` is what the current script produces | |||||
`out.png` is that `svg` passed through inkscape at 10x size |
@@ -0,0 +1,70 @@ | |||||
#lang racket | |||||
(require "xml.rkt") | |||||
(define-tag svg) | |||||
(define-tag defs) | |||||
(define-single-tag circle) | |||||
(define-single-tag rect) | |||||
(define-single-tag line) | |||||
(define-single-tag use) | |||||
(define-tag clipPath) | |||||
(displayln | |||||
(let | |||||
([doc-width 100] | |||||
[doc-height 100] | |||||
[stone-radius 5] | |||||
[black-colour "#222222"] | |||||
[white-colour "#DDDDDD"] | |||||
[stone-border 1] | |||||
[board-edge 2] | |||||
[board-colour "#F9D77D"] | |||||
[edge-colour "#000000"]) | |||||
(svg | |||||
([xmlns:xlink "http://www.w3.org/1999/xlink"] | |||||
[width doc-width] | |||||
[height doc-width]) | |||||
(defs () | |||||
(clipPath | |||||
([id "board-clip"]) | |||||
(rect | |||||
([width doc-width] | |||||
[height doc-height]))) | |||||
(circle | |||||
([id "black-stone"] | |||||
[cx 0] | |||||
[cy 0] | |||||
[r stone-radius] | |||||
[stroke-width stone-border] | |||||
[stroke white-colour] | |||||
[fill black-colour])) | |||||
(circle | |||||
([id "white-stone"] | |||||
[cx 0] | |||||
[cy 0] | |||||
[r stone-radius] | |||||
[stroke-width stone-border] | |||||
[stroke black-colour] | |||||
[fill white-colour]))) | |||||
(rect | |||||
([width doc-width] | |||||
[height doc-height] | |||||
[stroke edge-colour] | |||||
[clip-path "url(#board-clip)"] | |||||
[stroke-width (* 2 board-edge)] | |||||
[fill board-colour])) | |||||
(map (lambda (x) | |||||
(use | |||||
([xlink:href "#black-stone"] | |||||
[x (+ (/ doc-width 2) | |||||
(* 30 | |||||
(cos (/ (* x pi) | |||||
180))))] | |||||
[y (+ (/ doc-height 2) | |||||
(* 30 | |||||
(sin (/ (* x pi) | |||||
180))))]))) | |||||
(range 0 360 40))))) | |||||
(provide (all-defined-out)) |
@@ -0,0 +1 @@ | |||||
<svg xmlns:xlink="http://www.w3.org/1999/xlink" width="100" height="100"><defs><clipPath id="board-clip"><rect width="100" height="100"/></clipPath><circle id="black-stone" cx="0" cy="0" r="5" stroke-width="1" stroke="#DDDDDD" fill="#222222"/><circle id="white-stone" cx="0" cy="0" r="5" stroke-width="1" stroke="#222222" fill="#DDDDDD"/></defs><rect width="100" height="100" stroke="#000000" clip-path="url(#board-clip)" stroke-width="4" fill="#F9D77D"/><use xlink:href="#black-stone" x="80" y="50"/><use xlink:href="#black-stone" x="72.98133329356934" y="69.28362829059617"/><use xlink:href="#black-stone" x="55.20944533000791" y="79.54423259036625"/><use xlink:href="#black-stone" x="35.00000000000001" y="75.98076211353316"/><use xlink:href="#black-stone" x="21.80922137642275" y="60.260604299770065"/><use xlink:href="#black-stone" x="21.809221376422748" y="39.73939570022994"/><use xlink:href="#black-stone" x="34.999999999999986" y="24.019237886466847"/><use xlink:href="#black-stone" x="55.209445330007895" y="20.455767409633758"/><use xlink:href="#black-stone" x="72.98133329356934" y="30.716371709403813"/></svg> |
@@ -0,0 +1,86 @@ | |||||
#lang racket | |||||
(require | |||||
(for-syntax | |||||
racket/base | |||||
syntax/parse)) | |||||
(define (tag-start name attrs) | |||||
(string-append | |||||
(format "<~a" name) | |||||
(apply | |||||
string-append | |||||
(map (lambda (x) | |||||
(let ([t (car x)] | |||||
[v (cdr x)]) | |||||
(format " ~a=\"~a\"" t v))) | |||||
attrs)))) | |||||
(define (single-tag-end) | |||||
"/>") | |||||
(define (tag-end name content) | |||||
(string-append | |||||
">" | |||||
(if (list? content) | |||||
(apply string-append content) | |||||
content) | |||||
(format "</~a>" name))) | |||||
(define (tag name attrs content) | |||||
(string-append | |||||
(tag-start name attrs) | |||||
(tag-end name content))) | |||||
(define (single-tag name attrs) | |||||
(string-append | |||||
(tag-start name attrs) | |||||
(single-tag-end))) | |||||
(define-syntax (mtag stx) | |||||
(syntax-parse stx | |||||
[(_ name:id | |||||
([t:id v:expr] ...) | |||||
content:expr ...) | |||||
#'(tag | |||||
(symbol->string 'name) | |||||
(list | |||||
(cons | |||||
(symbol->string 't) | |||||
(if (number? v) | |||||
(number->string v) | |||||
v)) ...) | |||||
(apply string-append | |||||
(flatten | |||||
(list content ...))))])) | |||||
(define-syntax (msingle-tag stx) | |||||
(syntax-parse stx | |||||
[(_ name:id | |||||
([t:id v:expr] ...)) | |||||
#'(single-tag | |||||
(symbol->string 'name) | |||||
(list | |||||
(cons | |||||
(symbol->string 't) | |||||
(if (number? v) | |||||
(number->string v) | |||||
v)) ...))])) | |||||
(define-syntax (define-tag stx) | |||||
(syntax-parse stx | |||||
[(_ name:id) | |||||
#'(define-syntax (name stx) | |||||
(syntax-parse stx | |||||
[(_ attrs:expr content:expr (... ...)) | |||||
#'(mtag name attrs content (... ...))]))])) | |||||
(define-syntax (define-single-tag stx) | |||||
(syntax-parse stx | |||||
[(_ name:id) | |||||
#'(define-syntax (name stx) | |||||
(syntax-parse stx | |||||
[(_ attrs:expr) | |||||
#'(msingle-tag name attrs)]))])) | |||||
(provide (all-defined-out)) |