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