Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
黄金比や白銀比,青銅比などの貴金属比でパラメータを分割して一覧を出力するGaucheスクリプト
#!/usr/bin/env gosh
#|
Metallic Ratio Split
<USAGE>
1. Research Splited Values by metallic ratio
$ gosh metallic-split.scm 960
2. Generate CSS Format
$ gosh metallic-split.scm -c -b 1 -p 10 960 > style.css
$ gosh metallic-split.scm -r golden -c -b 2 -p 10 960 > golden_ratio.css
<OPTION>
-r | --ratio (defalut all) : select metallic ratio (golden | silver | bronze)
-c | --css : stdout to css
-b | --border : border-line stroke weight for css
-p | --padding : padding px for css
|#
(use srfi-1)
(use gauche.parseopt)
;;; Utility
(define (flatten xs) (if (pair? xs) (append-map flatten xs) (list xs)))
(define (key-map proc list)
(let1 affect (lambda (k r) (if (keyword? k)
(cons (proc k (get-keyword k list)) r)
r))
(reverse (fold affect '() list))))
(define string->keyword (compose make-keyword
list->string
(cut map char-downcase <>)
string->list
(cut regexp-replace #/[\s]/ <> "-")))
;;; Metallic Ratio Class
(define-class <metallic-ratio> ()
((name :init-value "One" :init-keyword :name :accessor name-of)
(num :init-value 0 :init-keyword :num :accessor num-of)))
(define-method value-of ((ratio <metallic-ratio>))
(let* ((num (num-of ratio))
(root (+ (expt num 2) 4)))
(/ (+ num (sqrt root))
2)))
(define-method expr-of ((ratio <metallic-ratio>))
(let* ((num (num-of ratio))
(root (+ (expt num 2) 4)))
(if (integer? (sqrt root))
(let1 num (+ num (sqrt root))
(if (even? num)
(format "~a" (/ num 2))
(format "~a / 2" num)))
(if (and (even? num) (even? (/ root 4)))
(format "~a + √~a" (/ num 2) (/ root 4))
(format "(~a + √~a) / 2" num root)))))
;; Splited Value Class
(define-class <splited-by-rate> ()
((rate :init-value 0 :init-keyword :rate :accessor rate-of)
(origin :init-value 0 :init-keyword :origin :accessor origin-of)))
(define-method parent-value-of ((splited <splited-by-rate>))
(* (origin-of splited) (rate-of splited)))
(define-method larger-value-of ((splited <splited-by-rate>))
(let ((rate (rate-of splited)))
(* (origin-of splited) (/ rate (+ 1 rate)))))
(define-method smaller-value-of ((splited <splited-by-rate>))
(* (origin-of splited) (/ 1 (+ 1 (rate-of splited)))))
(define-method split ((ratio <metallic-ratio>)
(value <number>))
(make <splited-by-rate> :rate (value-of ratio) :origin value))
(define (base-info value)
(map (lambda (l)
(if (pair? l) (format "[ ~a ] ~a" (car l) (cdr l)) l))
`(("Value" . ,value)
"==========================================")))
(base-info 900)
(define-method info-of-split ((ratio <metallic-ratio>)
(value <number>))
(let1 result (split ratio value)
(map (lambda (l)
(if (pair? l) (format "[ ~a ] ~a" (car l) (cdr l)) l))
`((,(name-of ratio) . ,(expr-of ratio))
("Value " . ,value)
("Rate " . ,(format #f "1 : ~a" (value-of ratio)))
("Smaller " . ,(smaller-value-of result))
("Larger " . ,(larger-value-of result))
("Parent " . ,(parent-value-of result))
"------------------------------------------"))))
(define (make-css attr props)
(letrec ((properties (key-map (cut format "\t~a: ~a;" <> <>) props)))
(list #`",|attr| {" properties "}\n")))
(define-method splited-css ((ratio <metallic-ratio>)
(value <number>)
(border-weight <integer>)
(padding <integer>))
(letrec ((make-attr-name (compose (cut regexp-replace #/-/ <> "_")
x->string
string->keyword))
(floor-int (compose x->integer floor))
(splited (split ratio value))
(name (make-attr-name (name-of ratio)))
(wrapper (- (floor-int (larger-value-of splited))
(* border-weight 2)))
(larger (- wrapper (* padding 2)))
(smaller (- (floor-int (smaller-value-of splited))
(+ border-weight
(* padding 2)))))
(list
"/*"
(format " * ~a : ~a" (name-of ratio) (expr-of ratio))
" * =========================================="
" */"
(key-map make-css (list
(make-keyword #`".,|name| .larger")
(list :float "left"
:width #`",|larger|px"
:min-height #`",|larger|px"
:padding #`",|padding|px"
:border-right #`",|border-weight|px solid #ccc")
(make-keyword #`".,|name| .smaller")
(list :float "left"
:width #`",|smaller|px"
:min-height #`",|larger|px"
:padding #`",|padding|px")
(make-keyword #`".,|name| header") `(:height ,#`",|smaller|px")
(make-keyword #`".,|name| article") `(:min-height ,#`",|wrapper|px")
(make-keyword #`".,|name| footer") `(:height ,#`",|smaller|px"))))))
(define *metallic-ratio-list*
(flatten
(let1 num 0
(map (lambda (name)
(list (string->keyword name)
(make <metallic-ratio>
:name #`",|name| Ratio" :num (inc! num))))
'("Golden" "Silver" "Bronze")))))
(flatten '((1 2) (3 4)))
(define-method base-css ((value <integer>)
(border <integer>)
(padding <integer>))
(let1 border-prop #`",|border|px solid #ccc"
(list
"/*"
#`" * Base Pixel : ,|value|px"
#`" * Padding : ,|padding|px"
#`" * Border Stroke Weight : ,|border|px"
" * ========================================"
" */"
(key-map make-css (list
:html '(:width "100%" :height "100%")
:body `(:width ,#`",|value|px" :margin "0 auto")
:header `(:padding ,#`",|padding|px" :border ,border-prop)
:article (list :clear "both"
:border-left border-prop
:border-right border-prop)
:footer (list :clear "both"
:padding #`",|padding|px"
:border border-prop))))))
;;; Script
(define (usage)
(format (current-error-port)
"Usage: ~a number value to split [Golden Silver Bronze] rate"
*program-name*)
(exit 2))
(define (find-ratio name list)
(let1 key (string->keyword name)
(if (member key list)
(get-keyword key list)
(begin
(format (current-error-port) "Unknown Named Ratio : ~a" name)
(exit 2)))))
(define (main args)
(if (null? (cdr args)) (usage)
(let-args (cdr args)
((css "c|css")
(border "b|border=i" 0)
(padding "p|padding=i" 0)
(ratio "r|ratio=s")
(else (opt . _) (print "Unknown option : " opt) (usage))
. restargs)
(if (null? restargs) (usage)
(letrec
((value (x->integer (car restargs)))
(make-base (if css
(base-css value border padding)
(base-info value)))
(make-form (lambda (_ ratio)
(if css
(splited-css ratio value border padding)
(info-of-split ratio value))))
(ratio-list *metallic-ratio-list*)
(splits (if ratio
(make-form #f (find-ratio ratio ratio-list))
(key-map make-form ratio-list)))
(result `(,make-base ,splits)))
(for-each print (flatten result))
0)))))
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.