(load "RewriteSchemes.scm")
(load "StringProcessing.scm")
(define (carpet->svg c w h)
    (treetostring (append
        `(svg ((height ,h) (width ,w)) )
        (map (lambda (x) `(polygon ((points ,(pointstostring (cdr x))) (style ,(string-append "fill:" (vertexdeviationcolour (cdr x)) "; stroke:#000040; stroke-width:2px;"))))) c))))

(define toparse "Quadpattern= (quad (_ _) (_ _) (_ _) (_ _)) => (tri (|2 |3) (|4 |5) (|0 |1)),(tri (|6 |7) (|0 |1) (|4 |5)),
Tripattern=(tri (_ _) (_ _) (_ _))=>(tri (|0 |1) (|2 |3) ((/ (+ |2 |4) 2) (/ (+ |3 |5) 2))),(tri ((/ (+ |2 |4) 2) (/ (+ |3 |5) 2)) (|4 |5) (|0 |1)),")

(define (assignment? s)  (if (string? s) (if (null? (cdr (string-split-first s "="))) #f (not (equal? (substring (cdr (string-split-first s "=")) 0 1) ">")))  #f))
(define (assignment name value) (cons 'assign (cons name (rule value))))
(define (rule s) (let ((io (string-split s "=>")))
    (let ((i (car io)) (o (cadr io)))
        (cons `,(split-s-expression-string i) (map split-s-expression-string (string-split o ","))))))
(define (parse_definition s)
    (if (assignment? s)
    ((lambda (x) (assignment (car x) (cdr x))) (string-split-first s "=")) (rule s)))
(define (parse_definitions s)
(map parse_definition (string-split s "
")))
(define rules (parse_definitions toparse))
(define definitions (map (lambda (x) (cons (cadr x) (patternrule (caddr x) (cdddr x)))) (filter (lambda (x) (equal? (car x)'assign)) rules)))
(define (iterate defs l) (if (null? l) '() (append (map (lambda (x) (cons (car x) (map (lambda (y) (list (eval (car y) user-initial-environment) (eval (cadr y) user-initial-environment))) (cdr x)))) (funclist defs (car l))) (iterate defs (cdr l)))))
(define (carpet defs i l) (if (zero? i) l (carpet defs (- i 1) (iterate defs l))))
(define output (carpet (map (lambda (x) (cdr x)) definitions) 8 '((quad (0 0) (1480 0) (1480 1480) (0 1480)))))
(save "testo" (carpet->svg output "1480" "1480"))