Small demo using Gauche-makiki

svg-levy-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