Skip to content

Instantly share code, notes, and snippets.

@shkmr shkmr/svg-levy-makiki
Last active Jan 29, 2016

Embed
What would you like to do?
Small demo using Gauche-makiki
#!/usr/bin/env gosh
;; -*-Scheme-*-
;;;
;;; Makiki Practice : Levy by SVG
;;;
;;(use ggc.util)
(use gauche.net)
(use gauche.parseopt)
(use gauche.parameter)
(use math.const)
(use text.html-lite)
(use text.tree)
(use makiki)
;;
;; levy on complex plane
;;
(define 1/sqrt2 (/ 1.0 (sqrt 2)))
(define z0 (make-rectangular 0.0 0.0))
(define z1 (make-rectangular 1.0 0.0))
(define (rotate t P) (map (^[z] (* z (make-polar 1 t))) P))
(define (shift zt P) (map (^[z] (+ z zt)) P))
(define (scale r P) (map (^[z] (* r z)) P))
(define (levy P n)
(cond ((> n 0)
(let ((U (scale 1/sqrt2 (rotate (- pi/4) P)))
(V (shift z1 (scale 1/sqrt2 (rotate pi/4 (shift (- z1) P))))))
(list (levy U (- n 1))
(levy V (- n 1)))))
(else
((draw) P))))
;;
;; svg
;;
(define (make-draw u)
(define (z->x z) (* u (+ 0.5 (real-part z))))
(define (z->y z) (* u (- 0.5 (imag-part z))))
(define (draw1 z rest)
(cond ((null? rest) '())
(else (list "<line "
"x1=\"" (z->x z) "\" "
"y1=\"" (z->y z) "\" "
"x2=\"" (z->x (car rest)) "\" "
"y2=\"" (z->y (car rest)) "\" "
"style=\"stroke:black; stroke-width:1\" "
"/>\n"
(draw1 (car rest) (cdr rest))))))
(lambda (P)
(if (null? P)
'()
(draw1 (car P) (cdr P)))))
(define draw (make-parameter (lambda (P) P)))
(define (svg-levy n W H)
(parameterize ((draw (make-draw (/ W 2))))
(list "<svg width=\"" W "\" height=\"" H "\">\n"
(levy (list z0 z1) n)
"</svg>"
)))
;;
;; Web App
;;
(define (main args)
(let-args (cdr args)
((port "p|port=i" 0)
. rest)
(start-http-server :access-log #f :error-log #t
:port port
:app-data (sys-ctime (sys-time))
:startup-callback print-url)
0))
(define (print-url server-socks)
(let ((port (any (^[s] (sockaddr-port (socket-address s))) server-socks)))
#;(let ((ports (map (^[s] (sockaddr-port (socket-address s))) server-socks)))
(begin (write server-socks) (newline))
(begin (write ports) (newline)))
(print #"Visit http://localhost:~|port|/")
(flush)))
(define-http-handler "/"
(with-post-parameters
(lambda (req app)
;;(pianissimo (request-headers req))
;;(pianissimo (request-params req))
(let* ((N (request-param-ref req "N"))
(n (if N (string->number N) 10))
(B (request-param-ref req "submit"))
(b (if B (string->symbol B) 'draw)))
(case b
((|+1|) (inc! n) (if (> n 16) (set! n 16)))
((|-1|) (dec! n) (if (< n 0) (set! n 0))))
(respond/ok req
(html:html
(html:head (html:title "Test SVG"))
(html:body
;; -------------------------------------------
(html:h2 "SVG Graphics")
(html:form
:action "/" :method "POST"
(html:p "N:" (html:input :type "number"
:name "N"
:value n
:min 0
:max 16)
(html:input :type "submit"
:name "submit"
:value "-1")
(html:input :type "submit"
:name "submit"
:value "+1")
(html:input :type "submit"
:name "submit"
:value "draw")
))
(svg-levy n 400 300)
;; -------------------------------------------
(html:h2 "Request Headers")
(html:pre
(map (^[p] (map (^[v] #`",(car p): \",v\"\n")
(cdr p)))
(request-headers req)))
;; -------------------------------------------
(html:h2 "Request Params")
(html:pre
(map (^[p] (map (^[v] #`",(car p): \",v\"\n")
(cdr p)))
(request-params req)))
)))))))
#|
(use ggc.util)
(pianissimo (levy (list z0 z1) 5)))
(pianissimo (svg-levy 5 400 300))
|#
;; EOF
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.