用Racket语言写了一个万花筒的程序

万花筒的程序"/>

用Racket语言写了一个万花筒的程序

用Racket语言写了一个万花筒的程序

　　Racket语言是Lisp语言的一个方言。Lisp语言具有神奇的魔力，可以全方位诠释哲学，而不像其它语言主要能够表达数学。
　　
　　这是我用它写的第一个完整程序，在此纪念一下下。

　　先来看看我的万花筒的神奇魅力，我相信以下画出来的图（带参数，可按参数重新绘出来）任何一个外边买的万花板都画不出来。不信来比：

• 这一个，注意全是尖角，中间空心呈方形：

• 这一个，花瓣中间的脉络全是直线，花心有两个圆：

• 能画出三角形吗？而且中间镶钻，两颗！

• 这个我画出来自己都被震撼了，如此的完美！

这个是不是超有立体感，不知进入了哪一个维度：

这一个，能不能找到冬天围脖的的温暖？不过哪个建筑这样修一定会拿大奖。

这个，怎么画出来的？（揭秘：将轨道起始角自图中值依次增加5并点画图按钮执行画图，经过N次之后，就出现这个神奇效果啦！）

这个，看起来很常规，不过，仔细看看！（揭秘：这是多次调整转轮半径后得到的效果。不过具体怎么的记不得了，可以自己去试。）

最后贴上源程序：

;=============================================================
;artascope.rkt
;主程序：#lang racket
(require racket/gui)
(require racket/draw)(require "model-simple.rkt")(include "view-main.rkt")(send main-frame show #t);=======================================================
;model-simple.rkt
;万花筒模型(module model-simple racket(provide draw-artascopeset-f-centerget-af0 set-af0 get-ap0 set-ap0get-rf set-rf get-rw set-rw get-rp set-rpget-step-aw set-step-awget-start-af set-start-af  get-end-af set-end-af);定义全局参数：(define f-center (cons 300 300))(define af0 30)(define ap0 20)(define rf 300)(define rw 210)(define rp 100)(define step-aw 30)(define start-af 0)(define end-af 7720);设置/取得绘图全局参数：(define (get-af0) af0)(define (set-af0 a) (set! af0 a))(define (get-ap0) ap0)(define (set-ap0 a) (set! ap0 a))(define (get-rf) rf)(define (set-rf r) (set! rf r))(define (get-rw) rw)(define (set-rw r) (set! rw r))(define (get-rp) rp)(define (set-rp r) (set! rp r))(define (get-step-aw) step-aw)(define (set-step-aw a) (set! step-aw a))(define (get-start-af) start-af)(define (set-start-af a) (set! start-af a))(define (get-end-af) end-af)(define (set-end-af a) (set! end-af a));取得绘图点的X、Y坐标：(define xp(lambda (xw ap)(+ xw (* rp (cos (degrees->radians ap))))))(define yp(lambda (yw ap)(+ yw (* rp (sin (degrees->radians ap))))));计算滚轮圆心X、Y坐标：(define xw(lambda (af)(+ (car f-center) (* (- rf rw) (cos (degrees->radians af))))))(define yw(lambda (af)(+ (cdr f-center) (* (- rf rw) (sin (degrees->radians af))))));计算af、dlt-af、ap值：(define af(lambda (dlt-af)(+ af0 dlt-af)))(define dlt-af(lambda (dlt-aw)(/ (* rw dlt-aw) rf)))(define ap(lambda (dlt-aw)(- ap0 dlt-aw)));组合坐标值为点值：(define (get-p dlt-aw)(cons (xp (xw (af (dlt-af dlt-aw))) (ap dlt-aw))(yp (yw (af (dlt-af dlt-aw))) (ap dlt-aw))))(define cur-aw(lambda (af)(/ (* af rf) rw)));绘制万花筒：(define draw-artascope(lambda (dc)(let ([p1 (get-p af0)])(do ([dlt-aw (cur-aw (+ af0 start-af)) (+ dlt-aw step-aw)])((> dlt-aw (cur-aw (+ af0 end-af))) "结束画图。")(let ([p2 (get-p dlt-aw)])(begin(send dc draw-lines (list p1 p2))(set! p1 p2)))))));设置画布中心点为轨道圆心点：;函数参数为函数，该函数参数取得画布的尺寸。(define (set-f-center canvas-size)(let-values ([(fx fy) (canvas-size)])(set! f-center (cons (/ fx 2) (/ fy 2))))));===============================================================
;view-mail.rkt
;定义主界面视图：;;;定义主界面：----------------------------------------------------------
(define main-frame(new frame%[label "万花筒(Artascope)"][width 800][height 600][border 5]));;;分割主界面：----------------------------------------------------------
;定义总面板：
(define panel-all(new vertical-panel%[parent main-frame][alignment '(left top)][stretchable-width #t][stretchable-height #t]));定义工具栏面板：
(define toolbars(new horizontal-panel%[parent panel-all][alignment '(left top)][stretchable-width #f][stretchable-height #f][border 2]));定义工作区：
(define panel-work(new horizontal-panel%[parent panel-all][alignment '(center center)]));定义画布面板：
(define panel-canvas(new vertical-panel%[parent panel-work][style '(border)][alignment '(left top)][border 10]));定义绘图参数设置面板
(define panel-setting(new vertical-panel%[parent panel-work][alignment '(right top)][border 5][min-width 180][stretchable-width #f]));;;定义画布：--------------------------------------------------------------
(define canvas(new canvas%[parent panel-canvas]));;;引入视图控制程序：--------------------------------------------------
(include "control-main.rkt");;;定义菜单----------------------------------------------------------------
(define menubar(new menu-bar%[parent main-frame]));;程序菜单：
(define menu-prog(new menu%[label "程序"][parent menubar]))
(define menu-item-draw(new menu-item%[label "画图"][parent menu-prog][callback draw]))
(define menu-item-clear(new menu-item%[label "清空画布"][parent menu-prog][callback clear]))
(define separator-menu-item-1(new separator-menu-item%[parent menu-prog]))
(define menu-item-exit(new menu-item%[label "退出"][parent menu-prog][callback(lambda (item event)(send main-frame on-exit))]));;帮助菜单：
(define menu-help(new menu%[label "帮助"][parent menubar]))
(define menu-item-help(new menu-item%[label "使用指南"][parent menu-help][callback help]))
(define menu-item-about(new menu-item%[label "关于"][parent menu-help][callback help]));;;定义工具栏按钮：----------------------------------------------------
(define toolbar-general(new horizontal-panel%[parent toolbars][alignment '(left top)][stretchable-width #f][stretchable-height #f]))(define button-draw(new button%[parent toolbar-general][label "画图"][callback draw]))(define button-clear(new button%[parent toolbar-general][label "清空画布"][callback clear]))(define button-help(new button%[parent toolbar-general][label "关于此程序"][callback help]));;;定义绘图参数设置控件：--------------------------------------------
;轨道参数：
(define group-box-panel-frame(new group-box-panel%(parent panel-setting)(label "轨道参数")(alignment (list 'right 'top))(stretchable-height #f)))
(define text-field-af0(new text-field%(parent group-box-panel-frame)(label "轨道圆起始角")(horiz-margin 5)(min-width 165)(stretchable-width #f)(init-value (number->string (get-af0)))))
(define text-field-rf(new text-field%(parent group-box-panel-frame)(label "轨道圆半径")(horiz-margin 5)(min-width 150)(stretchable-width #f)(init-value (number->string (get-rf)))))
(define text-field-start-af(new text-field%(parent group-box-panel-frame)(label "轨道起始角")(horiz-margin 5)(min-width 150)(stretchable-width #f)(init-value (number->string (get-start-af)))))
(define text-field-end-af(new text-field%(parent group-box-panel-frame)(label "轨道结束角")(horiz-margin 5)(min-width 150)(stretchable-width #f)(init-value (number->string (get-end-af)))));滚轮参数：
(define group-box-panel-wheel(new group-box-panel%(parent panel-setting)(label "滚轮参数")(alignment (list 'right 'top))(stretchable-height #f)))
(define text-field-ap0(new text-field%(parent group-box-panel-wheel)(label "绘制点起始角")(horiz-margin 5)(min-width 165)(stretchable-width #f)(init-value (number->string (get-ap0)))))
(define text-field-rw(new text-field%(parent group-box-panel-wheel)(label "滚轮半径")(horiz-margin 5)(min-width 135)(stretchable-width #f)(init-value (number->string (get-rw)))))
(define text-field-rp(new text-field%(parent group-box-panel-wheel)(label "绘制点半径")(horiz-margin 5)(min-width 150)(stretchable-width #f)(init-value (number->string (get-rp)))))
(define text-field-step-aw(new text-field%(parent group-box-panel-wheel)(label "滚轮角步距")(horiz-margin 5)(min-width 150)(stretchable-width #f)(init-value (number->string (get-step-aw)))));==========================================================
;control-main.rkt
;main视图的控制程序：;;;取得并设置绘图参数值(绘图面板函数)：---------------------------------
#|
af0 ap0
rf rw rp
step-aw
start-af end-af
|#
(define (set-draw-parameter)(set-af0 (string->number (send text-field-af0 get-value)))(set-ap0 (string->number (send text-field-ap0 get-value)))(set-rf (string->number (send text-field-rf get-value)))(set-rw (string->number (send text-field-rw get-value)))(set-rp (string->number (send text-field-rp get-value)))(set-step-aw (string->number (send text-field-step-aw get-value)))(set-start-af (string->number (send text-field-start-af get-value)))(set-end-af (string->number (send text-field-end-af get-value))));;;菜单命令/工具栏执行程序-----------------------------------------------------
;绘制万花筒：
(define (draw menu-item event)(set-draw-parameter);设置绘图参数(set-f-center (lambda () (send canvas get-client-size)));设置轨道中心点(draw-artascope (send canvas get-dc)));清空画布：
(define (clear menu-item event)(send canvas refresh));显示关于对话框：
(define (help menu-item event)(message-box "关于万花筒程序""万花筒程序：一个模拟万花筒的程序，用Racket编写。\n
本程序尽量全面展示了Racket语言GUI编程方式，以及基本的画布绘图操作。\n
作者：Racket" main-frame'(ok caution)))

源代码开源在Github上：.git