├── artascope.rkt ├── compiled └── drracket │ └── errortrace │ ├── model-simple_rkt.dep │ └── model-simple_rkt.zo ├── control-main.rkt ├── model-simple.rkt ├── pic ├── about.png ├── clear.png └── draw.png ├── view-main.rkt └── 绘图成果 ├── 2017102601.png ├── 2017102602.png ├── 2017102603.png ├── 2017102604.png ├── 2017102605.png ├── 2017102606.png ├── 2017102607.png └── 2017102608.png /artascope.rkt: -------------------------------------------------------------------------------- 1 | ;artascope.rkt 2 | ;主程序： 3 | 4 | #lang racket 5 | (require racket/gui) 6 | (require racket/draw) 7 | 8 | (require "model-simple.rkt") 9 | 10 | (include "view-main.rkt") 11 | 12 | (send main-frame show #t) 13 | -------------------------------------------------------------------------------- /compiled/drracket/errortrace/model-simple_rkt.dep: -------------------------------------------------------------------------------- 1 | ("6.9" ("7f21fa4ffc78ef7b7fc280ade9d2802f1c58df96" . "f065217d484cd60cffeafe4c2565056339d3e19d") (collects #"errortrace" #"errortrace-key.rkt") (collects #"racket" #"main.rkt") (collects #"racket" #"runtime-config.rkt")) 2 | -------------------------------------------------------------------------------- /compiled/drracket/errortrace/model-simple_rkt.zo: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OnRoadZy/artascope/58f87cf5b8b98d675cb88b6d9cf56139e816e5eb/compiled/drracket/errortrace/model-simple_rkt.zo -------------------------------------------------------------------------------- /control-main.rkt: -------------------------------------------------------------------------------- 1 | ;control-main.rkt 2 | ;main视图的控制程序： 3 | 4 | ;;;取得并设置绘图参数值(绘图面板函数)：======================================== 5 | #| 6 | af0 ap0 7 | rf rw rp 8 | step-aw 9 | start-af end-af 10 | |# 11 | (define (set-draw-parameter) 12 | (af0-v (string->number (send text-field-af0 get-value))) 13 | (ap0-v (string->number (send text-field-ap0 get-value))) 14 | (rf-v (string->number (send text-field-rf get-value))) 15 | (rw-v (string->number (send text-field-rw get-value))) 16 | (rp-v (string->number (send text-field-rp get-value))) 17 | (step-aw-v (string->number (send text-field-step-aw get-value))) 18 | (start-af-v (string->number (send text-field-start-af get-value))) 19 | (end-af-v (string->number (send text-field-end-af get-value)))) 20 | 21 | ;;;菜单命令/工具栏执行程序==================================================== 22 | ;绘制万花板： 23 | (define (draw menu-item event) 24 | (set-draw-parameter);设置绘图参数 25 | (set-f-center (lambda () (send canvas get-client-size)));设置轨道中心点 26 | (draw-artascope (send canvas get-dc))) 27 | 28 | ;清空画布： 29 | (define (clear menu-item event) 30 | (send canvas refresh)) 31 | 32 | ;显示关于对话框： 33 | (define (help menu-item event) 34 | (message-box "关于万花板程序" 35 | "万花板程序：一个模拟万花板的程序，用Racket编写。\n 36 | 本程序尽量全面展示了Racket语言GUI编程方式，以及基本的画布绘图操作。\n 37 | 作者：ZHY" 38 | main-frame 39 | '(ok caution))) 40 | 41 | -------------------------------------------------------------------------------- /model-simple.rkt: -------------------------------------------------------------------------------- 1 | ;model-simple.rkt 2 | ;万花筒模型 3 | 4 | (module model-simple racket 5 | 6 | (provide draw-artascope 7 | set-f-center 8 | af0-v ap0-v 9 | rf-v rw-v rp-v 10 | step-aw-v 11 | start-af-v end-af-v) 12 | 13 | ;定义全局参数： 14 | (define f-center (cons 300 300)) 15 | (define af0 30) 16 | (define ap0 20) 17 | (define rf 300) 18 | (define rw 210) 19 | (define rp 100) 20 | (define step-aw 30) 21 | (define start-af 0) 22 | (define end-af 7720) 23 | 24 | ;设置/取得绘图全局参数： 25 | (define af0-v 26 | (case-lambda 27 | [() af0] 28 | [(a) (set! af0 a)])) 29 | (define ap0-v 30 | (case-lambda 31 | [() ap0] 32 | [(a) (set! ap0 a)])) 33 | (define rf-v 34 | (case-lambda 35 | [() rf] 36 | [(r) (set! rf r)])) 37 | (define rw-v 38 | (case-lambda 39 | [() rw] 40 | [(r) (set! rw r)])) 41 | (define rp-v 42 | (case-lambda 43 | [() rp] 44 | [(r) (set! rp r)])) 45 | (define step-aw-v 46 | (case-lambda 47 | [() step-aw] 48 | [(a) (set! step-aw a)])) 49 | (define start-af-v 50 | (case-lambda 51 | [() start-af] 52 | [(a) (set! start-af a)])) 53 | (define end-af-v 54 | (case-lambda 55 | [()end-af] 56 | [(a) (set! end-af a)])) 57 | 58 | ;取得绘图点的X、Y坐标： 59 | (define xp 60 | (lambda (xw ap) 61 | (+ xw (* rp (cos (degrees->radians ap)))))) 62 | (define yp 63 | (lambda (yw ap) 64 | (+ yw (* rp (sin (degrees->radians ap)))))) 65 | 66 | ;计算滚轮圆心X、Y坐标： 67 | (define xw 68 | (lambda (af) 69 | (+ (car f-center) (* (- rf rw) (cos (degrees->radians af)))))) 70 | (define yw 71 | (lambda (af) 72 | (+ (cdr f-center) (* (- rf rw) (sin (degrees->radians af)))))) 73 | 74 | ;计算af、dlt-af、ap值： 75 | (define af 76 | (lambda (dlt-af) 77 | (+ af0 dlt-af))) 78 | (define dlt-af 79 | (lambda (dlt-aw) 80 | (/ (* rw dlt-aw) rf))) 81 | (define ap 82 | (lambda (dlt-aw) 83 | (- ap0 dlt-aw))) 84 | 85 | 86 | ;组合坐标值为点值： 87 | (define (get-p dlt-aw) 88 | (cons (xp (xw (af (dlt-af dlt-aw))) (ap dlt-aw)) 89 | (yp (yw (af (dlt-af dlt-aw))) (ap dlt-aw)))) 90 | 91 | (define cur-aw 92 | (lambda (af) 93 | (/ (* af rf) rw))) 94 | 95 | ;绘制万花筒： 96 | (define draw-artascope 97 | (lambda (dc) 98 | (let ([p1 (get-p af0)]) 99 | (do ([dlt-aw (cur-aw (+ af0 start-af)) (+ dlt-aw step-aw)]) 100 | ((> dlt-aw (cur-aw (+ af0 end-af))) "结束画图。") 101 | (let ([p2 (get-p dlt-aw)]) 102 | (begin 103 | (send dc draw-lines (list p1 p2)) 104 | (set! p1 p2))))))) 105 | 106 | ;设置画布中心点为轨道圆心点： 107 | ;函数参数为函数，该函数参数取得画布的尺寸。 108 | (define (set-f-center canvas-size) 109 | (let-values ([(fx fy) (canvas-size)]) 110 | (set! f-center (cons (/ fx 2) (/ fy 2))))) 111 | ) 112 | -------------------------------------------------------------------------------- /pic/about.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OnRoadZy/artascope/58f87cf5b8b98d675cb88b6d9cf56139e816e5eb/pic/about.png -------------------------------------------------------------------------------- /pic/clear.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OnRoadZy/artascope/58f87cf5b8b98d675cb88b6d9cf56139e816e5eb/pic/clear.png -------------------------------------------------------------------------------- /pic/draw.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OnRoadZy/artascope/58f87cf5b8b98d675cb88b6d9cf56139e816e5eb/pic/draw.png -------------------------------------------------------------------------------- /view-main.rkt: -------------------------------------------------------------------------------- 1 | ;view-mail.rkt 2 | ;定义主界面视图： 3 | 4 | ;;;定义主界面：================================================================ 5 | (define main-frame 6 | (new frame% 7 | [label "万花板(Artascope)"] 8 | [width 800] 9 | [height 600] 10 | [border 5])) 11 | 12 | ;;;分割主界面：================================================================= 13 | ;定义总面板： 14 | (define panel-all 15 | (new vertical-panel% 16 | [parent main-frame] 17 | [alignment '(left top)] 18 | [stretchable-width #t] 19 | [stretchable-height #t])) 20 | 21 | ;定义工具栏面板： 22 | (define toolbars 23 | (new horizontal-panel% 24 | [parent panel-all] 25 | [alignment '(left top)] 26 | [stretchable-width #f] 27 | [stretchable-height #f] 28 | [border 2])) 29 | 30 | ;定义工作区： 31 | (define panel-work 32 | (new horizontal-panel% 33 | [parent panel-all] 34 | [alignment '(center center)])) 35 | 36 | ;定义画布面板： 37 | (define panel-canvas 38 | (new vertical-panel% 39 | [parent panel-work] 40 | [style '(border)] 41 | [alignment '(left top)] 42 | [border 10])) 43 | 44 | ;定义绘图参数设置面板 45 | (define panel-setting 46 | (new vertical-panel% 47 | [parent panel-work] 48 | [alignment '(right top)] 49 | [border 5] 50 | [min-width 180] 51 | [stretchable-width #f])) 52 | 53 | ;;;定义画布：================================================================== 54 | (define canvas 55 | (new canvas% 56 | [parent panel-canvas])) 57 | 58 | ;;;引入视图控制程序：=========================================================== 59 | (include "control-main.rkt") 60 | 61 | ;;;定义菜单==================================================================== 62 | (define menubar 63 | (new menu-bar% 64 | [parent main-frame])) 65 | 66 | ;;程序菜单： 67 | (define menu-prog 68 | (new menu% 69 | [label "程序"] 70 | [parent menubar])) 71 | (define menu-item-draw 72 | (new menu-item% 73 | [label "画图"] 74 | [parent menu-prog] 75 | [callback draw])) 76 | (define menu-item-clear 77 | (new menu-item% 78 | [label "清空画布"] 79 | [parent menu-prog] 80 | [callback clear])) 81 | (define separator-menu-item-1 82 | (new separator-menu-item% 83 | [parent menu-prog])) 84 | (define menu-item-exit 85 | (new menu-item% 86 | [label "退出"] 87 | [parent menu-prog] 88 | [callback 89 | (lambda (item event) 90 | (send main-frame on-exit))])) 91 | 92 | ;;帮助菜单： 93 | (define menu-help 94 | (new menu% 95 | [label "帮助"] 96 | [parent menubar])) 97 | (define menu-item-help 98 | (new menu-item% 99 | [label "使用指南"] 100 | [parent menu-help] 101 | [callback help])) 102 | (define menu-item-about 103 | (new menu-item% 104 | [label "关于"] 105 | [parent menu-help] 106 | [callback help])) 107 | 108 | ;;;定义工具栏按钮：================================================================= 109 | (define toolbar-general 110 | (new horizontal-panel% 111 | [parent toolbars] 112 | [alignment '(left top)] 113 | [stretchable-width #f] 114 | [stretchable-height #f])) 115 | 116 | (define button-draw 117 | (new button% 118 | [parent toolbar-general] 119 | [label (list 120 | (make-object bitmap% "pic/draw.png") 121 | "画图" 122 | 'top)] 123 | [min-width 64] 124 | [min-height 64] 125 | [callback draw])) 126 | 127 | (define button-clear 128 | (new button% 129 | [parent toolbar-general] 130 | [label (list (make-object bitmap% 131 | "pic/clear.png") 132 | "清空画布" 133 | 'top)] 134 | [min-width 64] 135 | [min-height 64] 136 | [callback clear])) 137 | 138 | (define button-help 139 | (new button% 140 | [parent toolbar-general] 141 | [label (list 142 | (make-object bitmap% "pic/about.png") 143 | "关于此程序" 144 | 'top)] 145 | [min-width 64] 146 | [min-height 64] 147 | [callback help])) 148 | 149 | ;;;定义绘图参数设置控件：======================================================= 150 | ;轨道参数： 151 | (define group-box-panel-frame 152 | (new group-box-panel% 153 | (parent panel-setting) 154 | (label "轨道参数") 155 | (alignment (list 'right 'top)) 156 | (stretchable-height #f))) 157 | (define text-field-af0 158 | (new text-field% 159 | (parent group-box-panel-frame) 160 | (label "轨道圆起始角") 161 | (horiz-margin 5) 162 | (style '(single horizontal-label )) 163 | (min-width 162) 164 | (stretchable-width #f) 165 | (init-value (number->string (af0-v))))) 166 | (define text-field-rf 167 | (new text-field% 168 | (parent group-box-panel-frame) 169 | (label "轨道圆半径") 170 | (horiz-margin 5) 171 | (style '(single horizontal-label)) 172 | (min-width 150) 173 | (stretchable-width #f) 174 | (init-value (number->string (rf-v))))) 175 | (define text-field-start-af 176 | (new text-field% 177 | (parent group-box-panel-frame) 178 | (label "轨道起始角") 179 | (horiz-margin 5) 180 | (min-width 150) 181 | (stretchable-width #f) 182 | (init-value (number->string (start-af-v))))) 183 | (define text-field-end-af 184 | (new text-field% 185 | (parent group-box-panel-frame) 186 | (label "轨道结束角") 187 | (horiz-margin 5) 188 | (min-width 150) 189 | (stretchable-width #f) 190 | (init-value (number->string (end-af-v))))) 191 | 192 | ;滚轮参数： 193 | (define group-box-panel-wheel 194 | (new group-box-panel% 195 | (parent panel-setting) 196 | (label "滚轮参数") 197 | (alignment (list 'right 'top)) 198 | (stretchable-height #f))) 199 | (define text-field-ap0 200 | (new text-field% 201 | (parent group-box-panel-wheel) 202 | (label "绘制点起始角") 203 | (horiz-margin 5) 204 | (min-width 162) 205 | (stretchable-width #f) 206 | (init-value (number->string (ap0-v))))) 207 | (define text-field-rw 208 | (new text-field% 209 | (parent group-box-panel-wheel) 210 | (label "滚轮半径") 211 | (horiz-margin 5) 212 | (min-width 138) 213 | (stretchable-width #f) 214 | (init-value (number->string (rw-v))))) 215 | (define text-field-rp 216 | (new text-field% 217 | (parent group-box-panel-wheel) 218 | (label "绘制点半径") 219 | (horiz-margin 5) 220 | (min-width 150) 221 | (stretchable-width #f) 222 | (init-value (number->string (rp-v))))) 223 | (define text-field-step-aw 224 | (new text-field% 225 | (parent group-box-panel-wheel) 226 | (label "滚轮角步距") 227 | (horiz-margin 5) 228 | (min-width 150) 229 | (stretchable-width #f) 230 | (init-value (number->string (step-aw-v))))) 231 | 232 | ;画笔参数: 233 | (define group-box-panel-pen 234 | (new group-box-panel% 235 | (parent panel-setting) 236 | (label "画笔参数") 237 | (alignment (list 'right 'top)) 238 | (stretchable-height #f))) 239 | (define choice-color 240 | (new choice% 241 | (parent group-box-panel-pen) 242 | (label "&C颜色") 243 | (horiz-margin 5) 244 | (min-width 150) 245 | (stretchable-width #f) 246 | (choices (list "红色" "黑色" "蓝色")) 247 | (selection 1))) -------------------------------------------------------------------------------- /绘图成果/2017102601.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OnRoadZy/artascope/58f87cf5b8b98d675cb88b6d9cf56139e816e5eb/绘图成果/2017102601.png -------------------------------------------------------------------------------- /绘图成果/2017102602.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OnRoadZy/artascope/58f87cf5b8b98d675cb88b6d9cf56139e816e5eb/绘图成果/2017102602.png -------------------------------------------------------------------------------- /绘图成果/2017102603.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OnRoadZy/artascope/58f87cf5b8b98d675cb88b6d9cf56139e816e5eb/绘图成果/2017102603.png -------------------------------------------------------------------------------- /绘图成果/2017102604.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OnRoadZy/artascope/58f87cf5b8b98d675cb88b6d9cf56139e816e5eb/绘图成果/2017102604.png -------------------------------------------------------------------------------- /绘图成果/2017102605.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OnRoadZy/artascope/58f87cf5b8b98d675cb88b6d9cf56139e816e5eb/绘图成果/2017102605.png -------------------------------------------------------------------------------- /绘图成果/2017102606.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OnRoadZy/artascope/58f87cf5b8b98d675cb88b6d9cf56139e816e5eb/绘图成果/2017102606.png -------------------------------------------------------------------------------- /绘图成果/2017102607.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OnRoadZy/artascope/58f87cf5b8b98d675cb88b6d9cf56139e816e5eb/绘图成果/2017102607.png -------------------------------------------------------------------------------- /绘图成果/2017102608.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/OnRoadZy/artascope/58f87cf5b8b98d675cb88b6d9cf56139e816e5eb/绘图成果/2017102608.png --------------------------------------------------------------------------------