カテゴリ
全体プログラミング scheme verilog 未分類 以前の記事
2016年 04月2016年 03月 2016年 02月 2016年 01月 2015年 12月 2015年 11月 2015年 10月 2015年 09月 2015年 08月 2015年 07月 2015年 06月 2015年 03月 お気に入りブログ
PHPで競技プログラミングメモ帳
最新のトラックバック
ライフログ
検索
タグ
racket
その他のジャンル
ブログパーツ
最新の記事
外部リンク
ファン
記事ランキング
ブログジャンル
画像一覧
|
#lang racket/gui
(define x-size 300) (define y-size 300) (define (intersection-point line1 line2) (define d1 (map - (second line1) (first line1))) (define d2 (map - (second line2) (first line2))) (define norm-d2 (sqrt (foldr + 0 (map * d2 d2)))) (define n2 (map (lambda (x) (/ x norm-d2)) (list (second d2) (- (first d2))))) (define (inner-* p1 p2) (foldr + 0 (map * p1 p2))) (define param1 (/ (inner-* (map - (first line2) (first line1)) n2) (inner-* d1 n2))) (map + (first line1) (map (lambda (x) (* param1 x)) d1))) (define (regular-polygon n) (define angles (map (lambda (m) (* 2.0 pi (/ m n))) (range 0 n))) (map (lambda (phi) (list (sin (- phi)) (cos (- phi)))) angles)) (define (shift x y) (lambda (p) (map + p (list x y)))) (define (magnify x y) (lambda (p) (map * p (list x y)))) (define pentagon (map (shift (/ x-size 2) (/ y-size 2)) (map (magnify (/ x-size 2) (/ (- y-size) 2)) (regular-polygon 5)))) (define intersection-index-pairs (map (lambda (n) (map (lambda (m) (remainder (+ n m) 5)) '(0 2 1 4))) (range 0 5))) (define intersections (map (lambda (pair) (intersection-point (list (list-ref pentagon (first pair)) (list-ref pentagon (second pair))) (list (list-ref pentagon (third pair)) (list-ref pentagon (fourth pair))))) intersection-index-pairs)) (define lines (append (map (lambda (n) (append (list-ref pentagon n) (list-ref intersections n))) (range 0 5)) (map (lambda (n) (append (list-ref intersections n) (list-ref pentagon (remainder (+ n 1) 5)))) (range 0 5)))) (define target (make-bitmap x-size y-size)) (define dc (new bitmap-dc% [bitmap target])) (send dc set-pen "blue" 1 'solid) (for-each (lambda (line) (send dc draw-line (first line) (second line) (third line) (fourth line))) lines) (send target save-file "star.png" 'png)
by tempurature
| 2015-07-01 00:45
| scheme
| ||||||||||||||||||||||
ファン申請 |
||