├── LICENSE ├── README.md ├── drawing.red ├── ellipse-draw.red ├── frame-with-picture_1f5bc.png ├── layout.red └── quadratic-bezier-draw.red /LICENSE: -------------------------------------------------------------------------------- 1 | BSD 3-Clause License 2 | 3 | Copyright (c) 2023, Toomas Vooglaid 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | 1. Redistributions of source code must retain the above copyright notice, this 9 | list of conditions and the following disclaimer. 10 | 11 | 2. Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | 3. Neither the name of the copyright holder nor the names of its 16 | contributors may be used to endorse or promote products derived from 17 | this software without specific prior written permission. 18 | 19 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 20 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 21 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 22 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 23 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 24 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 25 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 26 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 27 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 28 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 29 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | (Not updated for a long time. May be broken) 2 | 3 | # Short intro to drawing-pad 4 | 5 | To draw simple figures click on canvas and drag. To draw "poly-" figures (polyline, polygon, spline) click and drag first line, then release and click and drag again to add points. For manipulations (inserts separate `translate`, `scale`, `skew` and `rotate`) and transformations (inserts single `transform`) click and drag: 6 | 7 | * for rotation, click sets the rotation center, drag creates "lever" (preferably drag initially away from center in 0 direction, i.e to right) to rotate the figure 8 | * for scaling, click sets the start of scaling, drag scales in relation to 0x0 coordinates (I will implement "local" scaling, i.e. in relation to coordinates set by click) 9 | * for skewing, again, click sets start, drag skews in relation to 0x0 (intend to implement "local" skewing) 10 | * for translation, click sets start, drag translates. 11 | 12 | Holding down control-key while drawing, switches on `ortho` mode, resulting in orthogonal (vertical or horizontal) lines. (As an interesting effect, if you hold control-key down while starting new line *after drawing an orthogonal line* the new line is drawn from starting point orthogonally to the last line. To avoid this, start line in normal mode and press `control` only after starting. I have not decided yet whether to consider this as a bug or as a feature.) 13 | 14 | Sift-key controls the grid-mode. If "Grid" is not checked, holding down `shift` switches grid-mode temporarily on, if it is checked, `shift` switches it temporarily off. Grid steps can be changed on edit-options-panel. (In second field, grid for angles is set (arc degrees to step)). 15 | 16 | Wheel-rotation over drawing area zooms in and out. New figures are inserted correctly under cursor in zoomed views. 17 | 18 | Pictures are inserted either from web (paste url into field) or from local file-system. First click after "OK" on file-selection window sets the top-left position for the picture, second click inserts picture - or - click and drag inserts picture to dragged dimensions. (Some bug, which I haven't succeeded to weed out, requires two mouse presses, instead of one. Working on this.) 19 | 20 | Wheel rotation above figures-list on right now changes selection, ctrl-wheel moves the selected figure up or down in z-order. 21 | 22 | Figure-manipulation commands can be selected from text-list's menu; for some commands keyboard shortcuts are defined. 23 | 24 | Local formatting for figures can be now selected from contextual menu on figures-list. E.g. to change pen color, select `Format->Pen->Color` and then select color from left side pen-color-picker. There are currently two color-pickers both for pen and fill-pen. First has Red-colors, second has full color-circle + transparency. 25 | 26 | Draw-block can be seen/copied/edited by clicking "View->Draw window" (opens window with draw-block) or "View->Draw console" (makes VID code of current layer which may be pasted into console with `do [..]`) on main menu. 27 | 28 | New layers are created by clicking on layer-tool on left panel. 29 | 30 | To play with animations, you have to: 31 | 32 | * first insert transformation (not manipulation!) for the figure, i.e. select figure and from menu select transformation and then click on canvas to set it (take eg. Transform->Translate", click on canvas and drag jst a little bit, relase), 33 | * then add animation descriptions to the "Animation" tab (print figure name, slash, 2, slash, number of , i.e number according to transformation syntax. 34 | 35 | Can also use this: 36 | 37 | ``` 38 | set [r-center angle scale-x scale-y translate][2 3 4 5 6] 39 | square1/2/:angle: tick 40 | ``` 41 | 42 | to change angle (i.e. animate rotation). 43 | `tick` is preset reserved word counting time ticks, 44 | * click "Animate" button on "Drawing" tab 45 | 46 | You can try out exampe animation files `quadratic-bezier-draw.red` and `ellipse-draw.red`. Do just `File->Open` and click `Animate`. 47 | 48 | Files can be saved and loaded, and layers can be exported to `png`, `jpeg` and `gif` formats. 49 | -------------------------------------------------------------------------------- /drawing.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Author: "Toomas Vooglaid" 3 | Last-version: 2019-02-15 4 | File: %drawing.red 5 | Needs: 'View 6 | Licence: "MIT" 7 | ] 8 | system/view/auto-sync?: off 9 | system/state/trace: 20 10 | clear-reactions 11 | ctx: context [ 12 | env: self 13 | step: 0 14 | last-step: 0 15 | last-mode: none 16 | start?: true 17 | figure: none;'line 18 | figures*: #() 19 | primary: #() 20 | secondary: #() 21 | layers*: 1 22 | template: object [ 23 | line: does [make deep-reactor! [ 24 | source: copy/part next selection-start selection-end 25 | point: find/tail source 'line 26 | length: is [sqrt add point/2/x - point/1/x ** 2 point/2/y - point/1/y ** 2] 27 | angle: is [180 / pi * arctangent2/radians point/2/y - point/1/y point/2/x - point/1/x] 28 | center: is [as-pair point/1/x + point/2/x / 2 point/1/y + point/2/y / 2] 29 | ;on-deep-change*: func [owner word target action new index part][probe reduce [owner word target action new index part]] 30 | ]] 31 | ;polyline: make deep-reactor! [ 32 | ; source: copy [] 33 | ; ;length: is 34 | ;] 35 | ;box: object [points: make block! 2] 36 | 37 | 38 | ] 39 | obj: #() 40 | make-obj: func [figure][ 41 | obj/:figure: 42 | ] 43 | figure-prop: #( 44 | line: [copy _points [pair! some pair!]] 45 | box: [set _top-left pair! set _bottom-right pair!] ; add corner 46 | circle: [set _center pair! set _radius [integer! | float!]] 47 | polygon: [copy _points [pair! pair! some pair!]] 48 | ellipse: [set _top-left pair! set _dimensions pair!] 49 | arc: [set _center pair! set _radius pair! set _begin integer! set _sweep integer! opt 'closed] 50 | text: [set _position pair! string!] 51 | image: [[image! | word!] set _top-left pair! opt [set _bottom-right pair!]] 52 | ) 53 | figure-move-points: #( 54 | line: [all] 55 | box: [2 3] 56 | circle: [2] 57 | ellipse: [2] 58 | polygon: [all] 59 | arc: [2] 60 | text: [2] 61 | image: [3 4] 62 | curve: [all] 63 | spline: [all] 64 | ) 65 | figure-points: [ 66 | line: [keep some pair!] 67 | box: [keep [pair! pair!]] 68 | circle: [keep pair!] 69 | ellipse: [keep pair!] 70 | polygon: [keep some pair!] 71 | arc: [keep pair!] 72 | text: [keep pair!] 73 | image: [[image! | word!] keep pair! opt [keep pair!]] 74 | curve: [keep some pair!] 75 | spline: [keep some pair!] 76 | ] 77 | flatten: function [block [any-block!] /with out /local b][ 78 | out: any [out clear []] 79 | foreach b block [either any-block? b [flatten/with b out][append out b]] 80 | out 81 | ] 82 | color-word: [ 83 | 'Red | 'white | 'transparent | 'black | 'gray | 'aqua | 'beige | 'blue 84 | | 'brick | 'brown | 'coal | 'coffee | 'crimson | 'cyan | 'forest | 'gold 85 | | 'green | 'ivory | 'khaki | 'leaf | 'linen | 'magenta | 'maroon | 'mint 86 | | 'navy | 'oldrab | 'olive | 'orange | 'papaya | 'pewter | 'pink | 'purple 87 | | 'reblue | 'rebolor | 'sienna | 'silver | 'sky | 'snow | 'tanned | 'teal 88 | | 'violet | 'water | 'wheat | 'yello | 'yellow | 'glass 89 | ] 90 | system/words/transparent: 255.255.255.254 ; ???? 91 | colors: exclude sort extract load help-string tuple! 2 [glass] 92 | ; DideC --> 93 | pallette: [ 94 | title "Select color" origin 1x1 space 1x1 95 | style clr: base 15x15 on-down [dn?: true] on-up [ 96 | if dn? [ 97 | either event/shift? [ 98 | append env/color-bag face/extra 99 | ][ 100 | env/color: either empty? env/color-bag [ 101 | face/extra 102 | ][ 103 | append env/color-bag face/extra 104 | ] 105 | unview 106 | ] 107 | ] 108 | ] 109 | ] 110 | x: 0 111 | color: none 112 | color-bag: copy [] 113 | dn?: none 114 | 115 | make-pallette: has [j][ 116 | clear color-bag 117 | foreach j colors [ 118 | append pallette compose/deep [ 119 | clr (j) extra (to-lit-word j) 120 | ] 121 | if (x: x + 1) % 9 = 0 [append pallette 'return] 122 | ] 123 | ] 124 | ; <-- DideC 125 | 126 | make-pallette 127 | color: black 128 | select-color: does [clear color-bag view/flags pallette [modal popup]] 129 | 130 | ; --> new color-picker 131 | make-color: func [i][ 132 | sector: (to-integer i - 1 / 64) + 1 133 | switch sector [ 134 | 1 [as-rgba 255 0 i - 1 * 4 0] 135 | 2 [as-rgba 255 - (i - 1 % 64 * 4) 0 255 0] 136 | 3 [as-rgba 0 i - 1 % 64 * 4 255 0] 137 | 4 [as-rgba 0 255 255 - (i - 1 % 64 * 4) 0] 138 | 5 [as-rgba i - 1 % 64 * 4 255 0 0] 139 | 6 [as-rgba 255 255 - (i - 1 % 64 * 4) 0 0] 140 | ] 141 | ] 142 | drw: copy [rotate -30 150x150 pen off ] 143 | collect/into [ 144 | repeat i 6 * 64 [ 145 | keep reduce [ 146 | 'rotate i - 1 * 0.9375 150x150 147 | compose [ 148 | fill-pen (make-color i) 149 | arc 150x150 128x128 0 1 closed 150 | ] 151 | ] 152 | ] 153 | ] drw 154 | append drw [ 155 | fill-pen radial 0.0.0.0 0.0.0.255 150x150 128 156 | circle 150x150 128 157 | ] 158 | alpha-val: 0 159 | grey-val: 0 160 | last-color: copy "pick a color" 161 | sz: 300x300 162 | palette2: make image! sz 163 | draw palette2 drw 164 | dn?: false 165 | request-color: has [colors value alpha grey disc disc2 found clr dn?][ 166 | colors: copy [] 167 | view/flags compose/deep [ 168 | value: text data [last-color] 169 | text 30x24 "alpha:" 170 | alpha: slider with [data: env/alpha-val] 171 | react later [ 172 | found: disc2/draw 173 | while [found: find next found block!][ 174 | found/1/2/4: to integer! alpha/data * 255 175 | ] 176 | show disc2 177 | ] 178 | return 179 | grey: slider 24x300 with [data: env/grey-val] 180 | on-up [ 181 | ;palette2: make image! sz 182 | draw palette2 disc2/draw 183 | disc/image: palette2 184 | ] 185 | react later [ 186 | change/part at tail disc2/draw -7 reduce [ 187 | as-rgba v: to integer! grey/data * 255 v v 0 188 | as-rgba v v v 255 189 | ] 2 190 | show disc2 191 | ] 192 | disc: image palette2 193 | at 44x44 disc2: box white 300x300 all-over 194 | on-over [ 195 | clr: pick palette2 event/offset 196 | attempt [clr/4: to integer! alpha/data * 255] 197 | value/text: form clr 198 | ] 199 | on-down [dn?: true] 200 | on-up [ 201 | if dn? [ 202 | clr: pick palette2 event/offset 203 | clr/4: to integer! alpha/data * 255 204 | either event/shift? [ 205 | append colors clr 206 | ][ 207 | env/color: either empty? colors [ 208 | clr 209 | ][ 210 | append colors clr 211 | ] 212 | env/alpha-val: alpha/data 213 | env/grey-val: grey/data 214 | env/last-color: form clr 215 | unview 216 | ] 217 | ] 218 | ] 219 | draw [(drw)] 220 | ][modal popup] 221 | ] 222 | ; <-- new color-picker 223 | 224 | comment { 225 | sz: 150x150 226 | grad-palette: make image! sz 227 | draw grad-palette compose [ 228 | pen off 229 | fill-pen linear red orange yellow green aqua blue purple 230 | box 0x0 (sz) 231 | fill-pen linear white glass black 0x0 (as-pair 0 sz/y) 232 | box 0x0 (sz) 233 | ] 234 | request-color: has [dn? sz colors][; Adapted from @greggirwin's %red-paint-with-time-travel.red 235 | colors: copy [] 236 | view/flags [ 237 | title "Select color" 238 | image grad-palette on-down [dn?: true] on-up [ 239 | if dn? [ 240 | either event/shift? [ 241 | append colors pick grad-palette event/offset 242 | ][ 243 | env/color: either empty? colors [ 244 | pick grad-palette event/offset 245 | ][ 246 | append colors pick grad-palette event/offset 247 | ] 248 | unview 249 | ] 250 | ] 251 | ] 252 | ][modal popup] 253 | ] 254 | } 255 | skip-colors: 0 256 | set-gradient: func [pen type pos1][ 257 | either block? env/color [ 258 | skip-colors: length? env/color 259 | either selection-start/2 = 'push [ 260 | either found-format: find/last/tail selection-start/3 pen [;find-deep selection-start/3 type [ 261 | switch step [ 262 | 1 [ 263 | parse found-format [s: [ 264 | if (any [find color-word s/1 tuple? s/1]) skip e: 265 | | thru ['pad | 'repeat | 'reflect] e: ; | 'tile | 'flip-x | 'flip-y | 'flip-xy | 'clamp] e: 266 | ] ( 267 | change/part s append insert env/color type reduce switch type [ 268 | linear [[pos1 pos1 'pad]] 269 | radial [[pos1 0 pos1 'pad]] 270 | diamond [[pos1 pos1 pos1 'pad]] 271 | ] e 272 | )] 273 | skip-colors: skip-colors + 4 274 | ] 275 | 2 [ 276 | found-format: find found-format pair! 277 | change/part found-format reduce switch type [ 278 | linear [[pos1 pos1]] 279 | radial [[pos1 0 pos1]] 280 | diamond [[pos1 pos1 pos1]] 281 | ] pick [2 3] type = 'linear 282 | skip-colors: 1 + index? found-format 283 | ] 284 | ] 285 | ][ 286 | insert selection-start/3 append append reduce [pen type] env/color reduce switch type [ 287 | linear [[pos1 pos1 'pad]] 288 | radial [[pos1 0 pos1 'pad]] 289 | diamond [[pos1 pos1 pos1 'pad]] 290 | ] 291 | skip-colors: skip-colors + 4 292 | ] 293 | ][ 294 | change/part next selection-start 295 | append/only copy [push] 296 | append append append reduce [pen type] env/color reduce switch type [ 297 | linear [[pos1 pos1 'pad]] 298 | radial [[pos1 0 pos1 'pad]] 299 | diamond [[pos1 pos1 pos1 'pad]] 300 | ] 301 | copy/part next selection-start selection-end 302 | selection-end 303 | skip-colors: skip-colors + 4 304 | ] 305 | env/step: 2 306 | ][probe "Use shift while gathering at least two colors! Select last color w/o shift."] 307 | ] 308 | result: none 309 | long-text: function [title-text][ 310 | view/flags/options [ 311 | title title-text 312 | below 313 | result: area 300x100 focus 314 | return 315 | button "OK" [result: result/text unview] 316 | button "Cancel" [result: copy "" unview] 317 | ][modal popup resize][ 318 | actors: object [ 319 | on-resizing: func [f e][ 320 | result/size: f/size - 92x20 321 | foreach-face/with f [ 322 | face/offset/x: f/size/x - face/size/x - 10 323 | ][face/type = 'button] 324 | show result 325 | ] 326 | ] 327 | ] 328 | either string? result [result][copy ""] 329 | ] 330 | write-program: does [long-text "Program figure"] 331 | ask-long-text: does [long-text "Enter text"] 332 | short-text: function [title-text /htext hint-text][ 333 | view/flags [ 334 | title title-text 335 | result: field 100 focus hint hint-text 336 | on-enter [result: result/text unview] 337 | button "OK" [result: result/text unview] 338 | ][modal popup] 339 | result 340 | ] 341 | ask-new-name: does [short-text/htext "Enter new name" "New name"] 342 | ask-text: does [short-text/htext "Enter text" "Enter text"] 343 | show-warning: func [msg][view/flags compose [title "Warning!" text (msg) button "OK" [unview]][modal popup]] 344 | load-file: has [result][ 345 | view/flags [ 346 | title "Enter location of file" 347 | result: field 150x20 hint "File location" 348 | button "Local file.." [ 349 | result/text: to-red-file request-file 350 | show result 351 | ] 352 | return 353 | button "OK" [ 354 | result: either url? result/data [ 355 | load result/data 356 | ][ 357 | result/data 358 | ] 359 | unview 360 | ] 361 | button "Cancel" [ 362 | result: none 363 | unview 364 | ] 365 | ][modal popup] 366 | result 367 | ] 368 | _ws: charset " ^-^/" 369 | _letter: charset [#"a" - #"z" #"A" - #"Z" #"_"] 370 | _symbol: union _letter charset [#"-" #"'" #"0" - #"9"] 371 | set-word: [_letter some _symbol #":"] 372 | show-draw: does [ 373 | view/options/flags compose [ 374 | title "Edit draw" 375 | below 376 | result: area 300x200 focus (mold canvas/draw) 377 | return 378 | button "Show" [canvas/draw: load result/text select-figure show canvas] ;new-line/all false 379 | button "Order" [ 380 | parse result/text [some [remove newline | skip]] 381 | parse result/text [some [ws s: set-word (insert s newline) | skip]] 382 | ] 383 | button "Close" [unview] 384 | ][ 385 | offset: win/offset + 600x0 386 | actors: object [ 387 | on-resizing: func [face event][ 388 | result/size: result/parent/size - 90x20 389 | result/parent/pane/2/offset/x: result/offset/x + result/size/x + 10 390 | result/parent/pane/3/offset/x: result/offset/x + result/size/x + 10 391 | result/parent/pane/4/offset/x: result/offset/x + result/size/x + 10 392 | show result/parent 393 | ] 394 | ] 395 | ][resize] 396 | ] 397 | show-console: does [write-clipboard mold append/only copy [view] append/only compose [box white (canvas/size) draw] canvas/draw] 398 | action: 'draw 399 | last-action: none 400 | canvas: none 401 | layers: figs: figs1: group: subgroup: subgroup2: none 402 | sep1: sep2: sep3: sep4: none 403 | select-layer: func [/pos selected][ 404 | selected: any [selected layers/selected] 405 | if selected [ 406 | canvas: get to-word pick layers/data layers/selected 407 | figs/data: canvas/extra/figs 408 | select-figure 409 | show [drawing-panel figs-panel] 410 | ] 411 | ] 412 | selection-start: none 413 | selection-end: none 414 | selected-figure: none 415 | select-figure: func [/pos selected /draw][; returns new `selected` for figs while deleting 416 | either empty? figs/data [ 417 | selection-start: tail canvas/draw 418 | selection-end: tail canvas/draw 419 | ][ 420 | selected: any [selected figs/selected] 421 | if selected [ 422 | selected-figure/text: pick figs/data selected 423 | show selected-figure 424 | selection-start: find-figure selected 425 | either selected = length? figs/data [ 426 | selection-end: length? selection-start 427 | either 1 < selected [selected - 1][none] ;??? Check it! 428 | ][ 429 | selection-end: find next selection-start load pick figs/data selected + 1 430 | selected 431 | ] 432 | ] 433 | figure: secondary/(selected-figure/text) 434 | ;current-drawing/text: figure recalc-info 435 | if select-fig/data [show-selected/sel] 436 | if edit/data [either draw [][edit-selection/new]] 437 | ] 438 | ] 439 | load-figure: func [fig][load pick figs/data fig]; Can be word! or block! (in case it is `pen`, `fill-pen` or `line-width`) 440 | find-figure: func [selected /tail /local figure found][ 441 | either word? figure: load-figure selected [ 442 | either tail [ 443 | skip find-deep canvas/draw figure figure-length/pos selected 444 | ][ 445 | find-deep canvas/draw figure 446 | ] 447 | ][ 448 | either found: find/reverse at figs/data selected form figure [ 449 | n: 1 450 | while [found: find/reverse found form figure][n: n + 1] 451 | found: next find canvas/draw figure 452 | loop n [found: next find found figure] 453 | either tail [skip back found length? figure][back found] 454 | ][ 455 | found: find canvas/draw figure 456 | either tail [skip found length? figure][found] 457 | ] 458 | ] 459 | ] 460 | find-deep: func [block needle /local found s][ 461 | unless found: find block needle [ 462 | parse block [ 463 | some [to block! s: if (found: find-deep s/1 needle) break | skip] 464 | ] 465 | ] 466 | found 467 | ] 468 | offset: func [_1 _2][offset? find-figure _1 find-figure _2] 469 | first-selected?: func [list /pos selected][selected: any [selected list/selected] selected = 1] 470 | second-selected?: func [list /pos selected][selected: any [selected list/selected] selected = 2] 471 | last-selected?: func [list /pos selected][selected: any [selected list/selected] selected = length? list/data] 472 | last-but-one-selected?: func [list /pos selected][selected: any [selected list/selected] (length? list/data) = (selected + 1)] 473 | next-figure: none 474 | redraw: does [canvas/draw: canvas/draw show canvas] 475 | figure-length: func [/pos selected /local figure selection][ 476 | selected: any [selected figs/selected] 477 | figure: load first selection: at figs/data selected 478 | any [ 479 | all [word? figure last-selected?/pos figs selected length? find-figure selected] 480 | all [word? figure offset selected selected + 1] 481 | length? figure 482 | ] 483 | ] 484 | adjust-pens: has [found][ 485 | if found: find/last canvas/draw 'line-width [pen-width/data: found/2 show pen-width] 486 | if found: find/last canvas/draw 'pen [pen-color/color: found/2 show pen-color] 487 | if found: find/last canvas/draw 'fill-pen [fill-color/color: found/2 show fill-color] 488 | ] 489 | join: cap: none 490 | line-joins: copy [] 491 | format-local: func [param value][ 492 | either selection-start/2 = 'push [ 493 | either found-format: find/last selection-start/3 param [ 494 | either all [ 495 | find [pen fill-pen] param 496 | not any [find color-word found-format/2 tuple? found-format/2] 497 | ][ 498 | parse next found-format [s: thru ['pad | 'repeat | 'reflect] e: (change/part s value e)] 499 | ][ 500 | change next found-format value 501 | ] 502 | ][ 503 | insert selection-start/3 reduce [param value] 504 | ] 505 | ][ 506 | change/part next selection-start 507 | append/only copy [push] 508 | append reduce [param value] 509 | copy/part next selection-start selection-end 510 | selection-end 511 | ] 512 | env/action: 'draw 513 | recalc-info 514 | redraw 515 | ] 516 | foreach join [miter bevel round] [ 517 | append line-joins compose/deep [ 518 | box 22x22 with [extra: (to-lit-word join)] draw [ 519 | pen gray box 0x0 21x21 pen black line-join (join) anti-alias off line-width 5 line 4x4 15x15 4x15 520 | ][ 521 | switch/default action [ 522 | insert [] ; TBD 523 | line-join [format-local 'line-join face/extra] 524 | ][ 525 | append canvas/draw [line-join (join)] 526 | append figs/data form [line-join (join)] 527 | figs/selected: length? figs/data 528 | select-figure 529 | show figs 530 | ] 531 | ] 532 | ] 533 | ] 534 | line-caps: copy [] 535 | foreach cap [flat square round] [ 536 | append line-caps compose/deep [ 537 | box 22x22 with [extra: (to-lit-word cap)] draw [ 538 | pen gray box 0x0 21x21 pen black line-cap (cap) anti-alias off line-width 5 line 5x10 16x10 539 | ][ 540 | switch/default action [ 541 | insert [] ; TBD 542 | line-cap [format-local 'line-cap face/extra] 543 | ][ 544 | append canvas/draw [line-cap (cap)] 545 | append figs/data form [line-cap (cap)] 546 | figs/selected: length? figs/data 547 | select-figure 548 | show figs 549 | ] 550 | ] 551 | ] 552 | ] 553 | move-in-list: func [list to-position][ 554 | ;selected: list/selected 555 | in-list: at list/data list/selected 556 | switch/default to-position [ 557 | front [unless last-selected? list [move in-list tail in-list] list/selected: length? list/data] 558 | forward [unless last-selected? list [move in-list next in-list] list/selected: list/selected + 1] 559 | backward [unless first-selected? list [move in-list back in-list] list/selected: list/selected - 1] 560 | back [unless first-selected? list [move in-list head in-list] list/selected: 1] 561 | ][ 562 | move in-list at list/data to-position 563 | ] 564 | ] 565 | move-selection: func [position /from pos1 /to pos2 /local tmp][ 566 | switch position [ 567 | front [ 568 | unless last-selected? figs [ 569 | move/part selection-start tail selection-start figure-length 570 | move-in-list figs 'front 571 | ] 572 | ] 573 | forward [ 574 | unless last-selected? figs [ 575 | move/part selection-start either last-but-one-selected? figs [ 576 | tail selection-start 577 | ][ 578 | back find-figure/tail figs/selected + 1 579 | ] 580 | figure-length 581 | move-in-list figs 'forward 582 | ] 583 | ] 584 | backward [ 585 | unless first-selected? figs [ 586 | move/part selection-start find-figure figs/selected - 1 figure-length 587 | move-in-list figs 'backward 588 | ] 589 | ] 590 | back [ 591 | unless first-selected? figs [ 592 | either canvas/draw/1 = 'matrix [ 593 | move/part selection-start at canvas/draw 3 figure-length 594 | ][ 595 | move/part selection-start head selection-start figure-length 596 | ] 597 | move-in-list figs 'back 598 | ] 599 | ] 600 | before [ 601 | case [ 602 | pos1 + 1 = pos2 [ 603 | move/part selection-start find-figure/tail pos2 figure-length/pos pos1 604 | move at figs/data pos1 at figs/data pos2 + 1 605 | ] 606 | pos2 = length? figs/data [ 607 | move/part selection-start tail selection-start figure-length/pos pos1 608 | move at figs/data pos1 tail figs/data 609 | ] 610 | 'else [ 611 | move/part selection-start find-figure/tail pos2 figure-length/pos pos1 612 | move at figs/data pos1 at figs/data pos2 + 1 613 | ] 614 | ] 615 | figs/selected: pos2 616 | ] 617 | swap [ 618 | if pos1 < pos2 [tmp: pos2 pos2: pos1 pos1: tmp] 619 | select-figure/pos pos1 620 | figs/selected: pos2 621 | move/part selection-start find-figure pos2 figure-length/pos pos1 622 | select-figure 623 | either pos1 = length? figs/data [ 624 | move/part selection-start tail selection-start figure-length 625 | ][ 626 | move/part selection-start skip find-figure pos1 + 1 -1 figure-length 627 | ] 628 | swap at figs/data pos1 at figs/data pos2 629 | ] 630 | ] 631 | select-figure 632 | show [figs canvas] 633 | adjust-pens 634 | ] 635 | move-layer: func [position /from pos1 /to pos2 /local tmp nope][ 636 | switch position [ 637 | front [ 638 | unless nope: last-selected? layers [ 639 | move at drawing-panel/pane layers/selected at drawing-panel/pane pos2: length? layers/data 640 | move-in-list layers 'front 641 | ] 642 | ] 643 | forward [ 644 | unless nope: last-selected? layers [ 645 | move at drawing-panel/pane layers/selected at drawing-panel/pane pos2: layers/selected + 1 646 | move-in-list layers 'forward 647 | ] 648 | ] 649 | backward [ 650 | unless nope: first-selected? layers [ 651 | move at drawing-panel/pane layers/selected at drawing-panel/pane pos2: layers/selected - 1 652 | move-in-list layers 'backward 653 | ] 654 | ] 655 | back [ 656 | unless nope: first-selected? layers [ 657 | move at drawing-panel/pane layers/selected head drawing-panel/pane 658 | move-in-list layers 'back 659 | pos2: 1 660 | ] 661 | ] 662 | before [ 663 | if pos1 > pos2 [pos2: pos2 + 1] 664 | move at drawing-panel/pane pos1 at drawing-panel/pane pos2 665 | move at layers/data pos1 at layers/data pos2 666 | ] 667 | swap [ 668 | if pos1 < pos2 [tmp: pos2 pos2: pos1 pos1: tmp] 669 | swap at drawing-panel/pane pos1 at drawing-panel/pane pos2 670 | swap at layers/data pos1 at layers/data pos2 671 | ] 672 | ] 673 | unless nope [ 674 | env/layers/selected: pos2 675 | env/canvas: drawing-panel/pane/:pos2 676 | env/figs/data: canvas/extra/figs 677 | show [drawing-panel figs-panel] 678 | ] 679 | ] 680 | insert-manipulation: func [type][ 681 | either selection-start/2 = 'push [ 682 | insert selection-start/3 switch type [ 683 | translate [[translate 0x0]] 684 | scale [[scale 1 1]] 685 | skew [[skew 0 0]] 686 | rotate [[rotate 0 0x0]] 687 | transform [if integer? selection-end [selection-end: selection-end + 6] [transform 0x0 0 1 1 0x0]] 688 | ] 689 | ][ 690 | change/part next selection-start 691 | append/only copy [push] 692 | append copy switch type [ 693 | translate [[translate 0x0]] 694 | scale [[scale 1 1]] 695 | skew [[skew 0 0]] 696 | rotate [[rotate 0 0x0]] 697 | transform [if integer? selection-end [selection-end: selection-end + 6] [transform 0x0 0 1 1 0x0]] 698 | ] copy/part next selection-start selection-end 699 | selection-end 700 | ] 701 | ] 702 | ;insert-grid: func [][] 703 | ;new-manipulation: func [type][ 704 | ; insert-manipulation type 705 | ; action: type 706 | ; step: 1 707 | ;] 708 | new-transformation: does [ 709 | unless all [selection-start/2 = 'push selection-start/3/1 = 'transform] [ 710 | insert-manipulation 'transform 711 | ] 712 | ] 713 | in-group?: false 714 | show-group-rule: [ 715 | [['transform | 'translate | 'scale | 'skew | 'rotate] to block! | ahead block!] (in-group?: true) into show-group-rule to end 716 | | if (in-group?) collect some [ 717 | s: set-word! keep (to-string s/1) | ['line-width | 'fill-pen | 'pen] keep (form copy/part s 2) | skip 718 | ] (in-group?: false) 719 | ] 720 | show-figs-rule: [ 721 | ; [['transform | 'translate | 'scale | 'skew | 'rotate] to block! | ahead block!] (in-group?: true) into show-group-rule to end 722 | ;| if (in-group?) 723 | collect some [ 724 | s: set-word! keep (to-string s/1) | ['line-width | 'fill-pen | 'pen] keep (form copy/part s 2) | skip 725 | ] 726 | ; (in-group?: false) 727 | ;] 728 | ] 729 | get-group-elements: does [] ;??? 730 | remove-transformations: does [ 731 | while [ 732 | find/match [transform translate scale skew] first next selection-start 733 | ][ 734 | change/part next selection-start first find selection-start block! find/tail selection-start block! 735 | ] 736 | ] 737 | unwrap-group: does [ 738 | remove-transformations 739 | head selection-start 740 | selection-start/2 741 | ] 742 | count: 0 743 | 744 | ; Grid-layer 745 | grid-layer: none 746 | ; Edit-layer 747 | ;found-transformations: found-formatting: 748 | ;found-figures: make block! 10 749 | drawing-layer: selection-layer: edit-layer: edit-points-panel: none 750 | copied-fig: copy [] 751 | figure-points2: [ 752 | some [s: 753 | set-word! 754 | | keep 'transform keep [pair! number! number! number! pair!] into figure-points2 755 | | keep 'translate keep pair! into figure-points2 756 | | keep 'scale keep [number! number!] into figure-points2 757 | | keep 'skew keep [number! number!] into figure-points2 758 | | keep 'rotate keep [number! pair!] into figure-points2 759 | | keep 'line keep [pair! some pair!] 760 | | keep 'box keep pair! keep pair! opt keep integer! 761 | | keep 'polygon keep [pair! pair! some pair!] 762 | | keep 'circle keep [pair! 1 2 number!] 763 | | keep 'ellipse keep [pair! pair!] 764 | | keep 'arc keep [pair! pair! integer! integer!] opt 'closed 765 | | keep 'curve keep [pair! pair! 1 2 pair!] 766 | | keep 'spline keep [pair! some pair! opt 'closed] 767 | | keep 'image [image! | word!] keep [pair! opt pair!] 768 | | keep 'text keep pair! string! 769 | | skip 770 | ] 771 | ] 772 | bind-figure-points: does [ 773 | clear copied-fig 774 | ;foreach [fig points] parse copied-fig: copy/part selection-start selection-end [collect figure-points] [ 775 | ; probe reduce [fig points] 776 | 777 | ;append drawing-panel/pane layout/only compose [ 778 | ; at (point - 5) box 11x11 loose draw [pen blue fill-pen 254.254.254.254 circle 5x5 5] 779 | ;] 780 | ;] 781 | parse copy/part selection-start selection-end [collect into copied-fig figure-points2] 782 | insert drawing-layer/draw flatten head insert copied-fig [pen blue] 783 | ;append drawing-panel/pane layout/only compose/deep [ 784 | ; at 0x0 box (drawing-panel/size) draw [(drw)] 785 | ;] 786 | show drawing-panel 787 | ] 788 | remove-pen: func [blk /local rule][ 789 | parse blk rule: [some [ 790 | remove [ 791 | ;['line-width integer!] 792 | ;| 793 | ['pen [ 794 | color-word 795 | | tuple! 796 | | word! thru ['pad | 'repeat | 'reflect] 797 | ]] 798 | ] 799 | | ahead block! into rule 800 | | skip 801 | ]] 802 | blk 803 | ] 804 | show-selected: func [/new /sel /local found len pos][ 805 | if any [new sel][clear at selection-layer/draw 4] 806 | case [ 807 | new [append selection-layer/draw copy/deep/part next selection-start selection-end] 808 | sel [append selection-layer/draw remove-pen copy/deep/part next selection-start selection-end] 809 | 'else [change/part at selection-layer/draw 4 remove-pen copy/deep/part next selection-start selection-end tail selection-layer/draw] 810 | ] 811 | selection-layer/draw: selection-layer/draw 812 | show selection-layer 813 | ] 814 | 815 | a-rate: none 816 | tick: 0 817 | phase: 1 818 | 819 | tab-pan: none 820 | drawing-panel-tab: none 821 | animations: scenes: none 822 | info-panel: options-panel: drawing-panel: figs-panel: anim-panel: none 823 | 824 | over-xy: over-params: current-drawing: current-action: current-step: none 825 | current-zoom: none 826 | recalc-info: has [i p][ 827 | repeat i length? p: info-panel/pane [ 828 | j: i - 1 829 | if i > 1 [p/:i/offset/x: p/(i - 1)/offset/x + p/(i - 1)/size/x + 5] 830 | if x: attempt [pick size-text p/:i 1][p/:i/size: as-pair x 35] 831 | ] 832 | show info-panel 833 | ] 834 | 835 | ortho?: cx: cy: none 836 | grid: g-size: g-angle: none 837 | select-fig: points: none 838 | 839 | imag: none 840 | _Matrix: none 841 | 842 | format: 1 ; line-width 843 | found-format: none 844 | drawing-on-grid?: func [shift?][any [all [grid/data not shift?] all [not grid/data shift?]]] 845 | current-pen: current-type: current-gradient: none ; for gradients 846 | 847 | pen-width: pen-color: pen-color2: fill-color: fill-color2: none 848 | 849 | format-params: [pen fill-pen line-width line-join line-cap] 850 | manipulation-params: [transform translate scale skew rotate] 851 | format-or-manipulation-params: append copy format-params copy manipulation-params 852 | figure-proper: none 853 | move?: none 854 | move-points: copy [] 855 | moveable: none 856 | find-figure-proper: func [/in block][ 857 | block: any [block selection-start] 858 | find-deep block select primary pick figs/data figs/selected 859 | ] 860 | ff: none 861 | delete: func [face][ 862 | put primary pick face/data face/selected none 863 | sel: select-figure 864 | remove at face/data face/selected 865 | remove/part selection-start selection-end 866 | face/selected: sel 867 | select-figure 868 | show [face canvas] 869 | ] 870 | rename: func [face][ 871 | new-name: ask-new-name 872 | either find face/data new-name [ 873 | show-warning "Name should be unique!" 874 | ][ 875 | primary/:new-name: primary/(pick face/data face/selected) 876 | put primary pick face/data face/selected none 877 | change at face/data face/selected new-name 878 | change selection-start to-set-word new-name 879 | selected-figure/text: new-name 880 | show selected-figure 881 | show face 882 | ] 883 | ] 884 | edit-selection: func [/new][ 885 | ;either event/type = over 886 | either new [ 887 | if figure-proper: find-figure-proper [ 888 | moveable: select figure-move-points figure-proper/1 889 | clear move-points 890 | parse next figure-proper reduce [ 891 | 'collect 'into 'move-points 892 | either find [parachain paratriple] figure [ 893 | [some [keep pair! | 'polygon]] 894 | ][ 895 | select figure-points figure-proper/1 896 | ] 897 | ] 898 | if block? move-points/1 [move-points: move-points/1] 899 | ;probe move-points 900 | clear edit-layer/pane 901 | found: selection-start 902 | forall move-points [ 903 | found: find next found move-points/1 904 | append edit-layer/pane layout/only head insert at copy/deep [ 905 | at base 10x10 loose glass draw [line-width 2 fill-pen transparent pen 80.150.255 circle 5x5 4] 906 | with [ 907 | extra: make map! reduce ['ref 1 + offset? selection-start found] 908 | actors: object [ 909 | me: none 910 | ;pos-tmp: none 911 | on-down: func [face event][ 912 | face/draw/4: 80.150.255 913 | foreach-face/with face/parent [ 914 | face/extra/pos1: face/offset 915 | ;either grid/data [ 916 | ; as-pair round/to face/offset/x g-size/data/x round/to face/offset/y g-size/data/y 917 | ;][face/offset] 918 | ][face/draw/4 = 80.150.255] 919 | me: face 920 | show face 921 | 'done 922 | ] 923 | on-up: func [face event][ 924 | unless event/shift? [ 925 | face/draw/4: 'transparent 926 | show face 927 | ] 928 | 'done 929 | ] 930 | ;on-over: func [face event]['done] 931 | ;on-alt-down: func [face event][ 932 | ; face/draw/4: either face/draw/4 = 'transparent [80.150.255]['transparent] 933 | ; show face 934 | ; 'done 935 | ;] 936 | ;on-alt-up: func [face event]['done] 937 | on-drag: func [face event /local diff][ 938 | face/extra/pos2: either grid/data [ 939 | face/offset: subtract as-pair round/to face/offset/x + 5 g-size/data/x round/to face/offset/y + 5 g-size/data/y 5x5 940 | ][face/offset] 941 | if face/extra/pos2 <> face/extra/pos1 [ ;probe reduce [face/extra/pos2 face/extra/pos1] 942 | selection-start/(face/extra/ref): face/extra/pos2 + 5x5 943 | diff: face/extra/pos2 - face/extra/pos1 944 | face/extra/pos1: face/extra/pos2 945 | foreach-face/with face/parent [ 946 | face/offset: face/extra/pos1 + diff 947 | selection-start/(face/extra/ref): face/offset + 5x5 948 | face/extra/pos1: face/offset 949 | ][ 950 | all [ 951 | face <> me 952 | face/draw/4 = 80.150.255 953 | ] 954 | ] 955 | ;probe reduce [selection-start face/extra/ref selection-start/(face/extra/ref)] 956 | show [edit-layer canvas] 957 | show-selected/sel 958 | ] 959 | 'done 960 | ] 961 | ] 962 | ] 963 | ] 2 move-points/1 - 5x5 964 | ] 965 | ;probe edit-layer/pane/1/draw 966 | ;probe edit-layer/pane 967 | comment { 968 | either moveable/1 = 'all [ 969 | either find [parachain paratriple] figure [ 970 | forall move-points [ 971 | x: divide -1 + index? move-points 4 972 | poke figure-proper x + 1 + index? move-points move-points/1 + diff 973 | ] 974 | ][ 975 | forall move-points [poke figure-proper 1 + index? move-points move-points/1 + diff] 976 | ] 977 | ][ 978 | either figure-proper/1 = 'arc [ 979 | forall move-points [poke figure-proper -1 move-points/1 + diff poke figure-proper pick moveable index? move-points move-points/1 + diff] 980 | ][ 981 | forall move-points [poke figure-proper pick moveable index? move-points move-points/1 + diff] 982 | ] 983 | ] 984 | } 985 | show edit-layer 986 | ] 987 | ][ 988 | 989 | ] 990 | ] 991 | win: layout/options compose/deep [ 992 | title "Drawing pad" 993 | size 600x510 994 | tab-pan: tab-panel snow 580x490 [ 995 | "Drawing" [;backdrop green 996 | ;drawing-panel-tab: panel snow [origin 0x0 space 0x0 997 | across 998 | info-panel: panel snow 560x25 [ 999 | origin 0x0 1000 | space 4x0 1001 | over-xy: text 10x20 1002 | over-params: text 20x20 1003 | current-zoom: text 20x20 1004 | current-action: text 40x20 1005 | current-drawing: text 80x20 1006 | current-step: text 40x20 1007 | ] 1008 | return 1009 | edit-options-panel: panel snow 560x25 [ 1010 | origin 0x0 1011 | space 4x0 1012 | text 50x20 "Selected:" 1013 | selected-figure: text 80x20 1014 | grid: check "Grid:" 45x20 [grid-layer/visible?: face/data poke find grid-layer/draw pair! 1 g-size/data show grid-layer] 1015 | g-size: field 40x20 "10x10" [poke find grid-layer/draw pair! 1 g-size/data show grid-layer] 1016 | g-angle: field 20x20 "10" text 5x20 "°" 1017 | g-step: field 40x20 "5x5" 1018 | select-fig: check "Select" [ 1019 | selection-layer/visible?: face/data 1020 | if all [face/data not empty? figs/data][show-selected/sel] 1021 | show selection-layer 1022 | ] 1023 | edit: check "Edit" [ 1024 | edit-layer/visible?: face/data 1025 | if face/data [ 1026 | ;system/view/capturing?: yes 1027 | if not select-fig/data [ 1028 | select-fig/data: yes 1029 | do-actor select-fig none 'change 1030 | show select-fig 1031 | ] 1032 | edit-selection/new 1033 | action: 'edit current-action/text: form action recalc-info 1034 | ];[system/view/capturing?: no] 1035 | show edit-layer 1036 | ] 1037 | button "clear" [ 1038 | clear at canvas/draw 3 1039 | canvas/draw/2: [1 0 0 1 0 0] 1040 | clear at selection-layer/draw 3 1041 | selection-layer/draw/2: [1 0 0 1 0 0] 1042 | clear edit-layer/pane 1043 | show [canvas selection-layer edit-layer] 1044 | ;probe length? figs/data 1045 | 1046 | foreach-face/with figs-panel [ 1047 | clear face/data 1048 | either face/extra = 'figs1 [ 1049 | face/size/y: face/parent/size/y 1050 | ][face/visible?: false] 1051 | ][2 < index? find face/parent/pane face] 1052 | show figs-panel 1053 | 1054 | foreach key keys-of figures* [figures*/:key: none] 1055 | 1056 | pen-width/data: 1 1057 | pen-color/color: 0.0.0 1058 | fill-color/color: 254.254.254.254 1059 | show [pen-width pen-color fill-color] 1060 | 1061 | action: 'draw figure: 'line 1062 | foreach-face info-panel [clear face/text] 1063 | current-action/text: "draw" current-drawing/text: "line" 1064 | select-fig/data: off edit/data: off 1065 | selected-figure/text: "" show edit-options-panel 1066 | recalc-info 1067 | ] 1068 | ] 1069 | return 1070 | ;below 1071 | options-panel: panel snow 80x380 [ 1072 | origin 0x0 1073 | space 0x0 1074 | style f: button 25x25 [ 1075 | env/figure: face/extra 1076 | start?: true 1077 | action: 'draw 1078 | if edit/data [edit-layer/visible?: edit/data: false show [edit edit-layer]] 1079 | step: 0 1080 | current-action/text: form action 1081 | current-drawing/text: form face/extra 1082 | current-step/text: rejoin ["Step: " step] 1083 | current-zoom/text: "z: 1" 1084 | recalc-info 1085 | ] 1086 | f with [extra: 'line image: (draw 23x23 [line 5x5 17x17])] 1087 | f with [extra: 'polyline image: (draw 23x23 [line 5x5 8x17 13x5 17x17])] 1088 | f with [extra: 'arc image: (draw 23x23 [arc 11x13 6x6 -180 180])] 1089 | return 1090 | f with [extra: 'box image: (draw 23x23 [fill-pen snow box 5x7 17x15])] 1091 | f with [extra: 'square image: (draw 23x23 [fill-pen snow box 5x5 17x17])] 1092 | f with [extra: 'polygon image: (draw 23x23 [fill-pen snow polygon 5x8 11x5 17x8 14x17 8x17])] 1093 | return 1094 | f with [extra: 'ellipse image: (draw 23x23 [fill-pen snow ellipse 5x6 13x10])] 1095 | f with [extra: 'circle image: (draw 23x23 [fill-pen snow circle 11x11 6])] 1096 | f with [extra: 'sector image: (draw 23x23 [fill-pen snow arc 5x11 12x6 -25 50 closed])] 1097 | return 1098 | f with [extra: 'paragram image: (draw 23x23 [fill-pen snow polygon 5x5 17x9 17x17 5x13])];fill-pen snow polygon 5x7 11x11 11x17 5x13])] 1099 | f with [extra: 'parachain image: (draw 23x23 [ 1100 | fill-pen snow 1101 | polygon 5x5 9x9 9x17 5x13 1102 | polygon 9x9 13x5 13x13 9x17 1103 | polygon 13x5 17x9 17x17 13x13 1104 | ])] 1105 | f with [extra: 'paratriple image: (draw 23x23 [ 1106 | fill-pen snow 1107 | polygon 5x7 11x11 11x17 5x13 1108 | polygon 5x7 11x3 17x7 11x11 1109 | polygon 11x11 17x7 17x13 11x17 1110 | ])] 1111 | return 1112 | f with [extra: 'curve image: (draw 23x23 [curve 5x11 11x2 17x17])] 1113 | f with [extra: 'cubicCurve image: (draw 23x23 [curve 5x11 9x0 13x23 17x11])] 1114 | f with [extra: 'spline image: (draw 23x23 [spline 5x7 5x17 7x17 9x11 13x11 15x17 17x17 17x7])];[spline 6x7 8x7 10x15 12x15 14x7 16x7 17x11 11x12 5x11 closed])] 1115 | return 1116 | f with [extra: 'freehand image: (draw 23x23 [line 5x5 7x5 7x8 10x8 10x6 13x6 13x9 17x9 17x12 14x12 14x17 17x17])] 1117 | f with [extra: 'program 1118 | image: (draw 23x23 [line 5x5 10x5 line 5x7 14x7 line 5x9 10x9 line 5x11 17x11 line 7x13 10x13 line 7x15 12x15 line 5x17 8x17]) 1119 | ] 1120 | f with [extra: 'splineC image: (draw 23x23 [fill-pen snow spline 11x5 5x11 5x17 7x17 9x11 13x11 15x17 17x17 17x11 closed])];[spline 6x7 8x7 10x15 12x15 14x7 16x7 17x11 11x12 5x11 closed])] 1121 | return 1122 | f with [extra: 'image image: (draw 23x23 compose [ 1123 | image (load/as read/binary %frame-with-picture_1f5bc.png 'png) -3x-3 25x25 1124 | ;https://emojipedia-us.s3.amazonaws.com/thumbs/160/emoji-one/44/frame-with-picture_1f5bc.png 1125 | ])] on-up [imag: load-file env/figure: 'image] 1126 | f with [extra: 'ortho-grid image: (draw 23x23 [box 5x5 17x17 line 8x5 8x17 line 11x5 11x17 line 14x5 14x17 line 5x8 17x8 line 5x11 17x11 line 5x14 17x14])] 1127 | ;f with [extra: 'radial-grid image: (draw 23x23 [])] 1128 | f with [extra: 'layer image: (draw 23x23 [fill-pen snow polygon 5x17 9x10 17x10 13x17 polygon 5x12 9x5 17x5 13x12])][ 1129 | ;env/canvas/extra/figs: figs/data 1130 | ;clear figs/data 1131 | append layers/data ff: rejoin ["layer" layers*: layers* + 1] 1132 | insert at drawing-panel/pane -2 + length? drawing-panel/pane layout/only head insert at copy/deep [ 1133 | at 0x0 box glass draw [matrix [1 0 0 1 0 0]] with [ 1134 | extra: make map! reduce ['figs copy []] 1135 | size: is [drawing-panel/size] 1136 | actors: object [ 1137 | on-time: func [face event /local r-center angle scale-x scale-y translate][ 1138 | ;if all [action = 'animate step = 2 selection-start/2 = 'transform] [ 1139 | ; selection-start/4: anim-step: anim-step + 1 1140 | ; show face 1141 | ;] 1142 | do bind bind load animations drawing-layer env 1143 | show canvas 1144 | ] 1145 | ] 1146 | ] 1147 | ] 3 to-set-word ff 1148 | env/canvas: get to-word ff 1149 | figs: figs1 1150 | figs/data: canvas/extra/figs 1151 | layers/visible?: sep1/visible?: true 1152 | layers/size/y: layers/size/y + 20 1153 | sep1/offset/y: layers/size/y 1154 | figs/offset/y: sep1/offset/y + sep1/size/y 1155 | figs/size/y: figs/size/y - 60 1156 | layers/selected: length? layers/data 1157 | 1158 | ;win/size: win/size + 0x0 1159 | show [drawing-panel figs-panel] 1160 | selection-start: at canvas/draw 3 selection-end: tail canvas/draw 1161 | ;redraw 1162 | ] 1163 | return 1164 | f with [extra: 'text image: (draw 23x23 [text 6x2 "T"])] 1165 | f with [extra: 'area image: (draw 23x23 [text 6x2 "A"])] 1166 | f with [extra: 'area image: (draw 23x23 [text 3x2 "RT"])] 1167 | return 1168 | do [current-drawing/text: rejoin ["draw line"] ];recalc-info] Causes error in start-up! 1169 | return below 1170 | group-box "pen" [ 1171 | origin 2x10 space 2x2 1172 | pen-width: field 22x22 "1" [ 1173 | switch/default action [ 1174 | insert [] ; TBD 1175 | line-width [ 1176 | format-local 'line-width face/data 1177 | unless find/part at selection-start 4 'line-width selection-end [ 1178 | either last-selected? figs [ 1179 | append selection-start reduce ['line-width format] 1180 | ][ 1181 | insert back selection-end reduce ['line-width format] 1182 | ] 1183 | ] 1184 | face/data: format show face 1185 | ;env/action: 'draw recalc-info 1186 | ;show canvas 1187 | ] 1188 | ][ 1189 | append canvas/draw reduce ['line-width face/data] 1190 | append figs/data form reduce ['line-width face/data] 1191 | figs/selected: length? figs/data 1192 | select-figure 1193 | show figs 1194 | ] 1195 | ] 1196 | pen-color: base 22x22 black draw [pen gray box 0x0 21x21][ 1197 | if block? color [env/color: color/1] 1198 | select-color 1199 | switch/default action [ 1200 | insert [] ; TBD 1201 | pen [ 1202 | format-local 'pen color 1203 | env/color: format 1204 | ] 1205 | pen-linear or 1206 | pen-radial or 1207 | pen-diamond [face/color: format] 1208 | ][ 1209 | if not word? color [env/color: 'black] 1210 | append canvas/draw reduce ['pen color] 1211 | append figs/data form reduce ['pen color] 1212 | figs/selected: length? figs/data 1213 | select-figure 1214 | show figs 1215 | ] 1216 | face/color: either word? color [get color][color] 1217 | show face 1218 | ] 1219 | pen-color2: base 22x22 black draw [pen gray box 0x0 21x21][ 1220 | request-color 1221 | switch/default action [ 1222 | insert [] ; TBD 1223 | pen [ 1224 | format-local 'pen color 1225 | env/color: format 1226 | ] 1227 | pen-linear or 1228 | pen-radial or 1229 | pen-diamond [face/color: format] 1230 | ][ 1231 | append canvas/draw reduce ['pen color] 1232 | append figs/data form reduce ['pen color] 1233 | figs/selected: length? figs/data 1234 | select-figure 1235 | show figs 1236 | ] 1237 | face/color: color 1238 | show face 1239 | ] 1240 | ;return 1241 | ;(gradient-pens) 1242 | return 1243 | (line-joins) 1244 | return 1245 | (line-caps) 1246 | ] 1247 | group-box "fill" [ 1248 | origin 2x10 space 2x2 1249 | fill-color: base 22x22 0.0.0.254 draw [pen gray box 0x0 21x21][ 1250 | if block? color [env/color: color/1] 1251 | select-color 1252 | switch/default action [ 1253 | insert [] 1254 | fill [ 1255 | format-local 'fill-pen color 1256 | env/color: format 1257 | ] 1258 | fill-linear or 1259 | fill-radial or 1260 | fill-diamond [];face/color: format] 1261 | background [ 1262 | env/canvas/color: either word? env/color [get env/color][color] 1263 | show canvas 1264 | ] 1265 | ][ 1266 | if not word? color [env/color: 'black] 1267 | append canvas/draw reduce ['fill-pen color] 1268 | append figs/data form reduce ['fill-pen color] 1269 | figs/selected: length? figs/data 1270 | select-figure 1271 | show figs 1272 | face/color: color;either word? color [get color][color] 1273 | ] 1274 | show face 1275 | ] 1276 | fill-color2: base 22x22 snow draw [pen gray box 0x0 21x21][ 1277 | request-color 1278 | switch/default action [ 1279 | insert [] 1280 | fill [ 1281 | format-local 'fill-pen color 1282 | face/color: env/color: format 1283 | ] 1284 | fill-linear or 1285 | fill-radial or 1286 | fill-diamond [face/color: format] 1287 | background [ 1288 | env/canvas/color: either word? env/color [get env/color][color] 1289 | show canvas 1290 | ] 1291 | ][ 1292 | append canvas/draw reduce ['fill-pen color] 1293 | append figs/data form reduce ['fill-pen color] 1294 | figs/selected: length? figs/data 1295 | select-figure 1296 | show figs 1297 | face/color: color 1298 | ] 1299 | show face 1300 | ] 1301 | ;return 1302 | ;(gradient-fills) 1303 | ] 1304 | ] 1305 | ;return 1306 | drawing-panel: panel snow 360x345 [ 1307 | origin 0x0 1308 | space 0x0 1309 | style layer: box glass draw [matrix [1 0 0 1 0 0]] with [extra: #()] 1310 | style drawing: base white 300x300 all-over 1311 | ;rate 1;none 1312 | draw [matrix [1 0 0 1 0 0]];_Matrix: 1313 | with [ 1314 | actors: object [ 1315 | pos1: 0x0 1316 | pos-tmp: 0x0 1317 | last-pos: 0x0 ; for arcs and sectors 1318 | last-offset: 0x0 ; for grid 1319 | pre-diff: 0x0 1320 | pre-angle: 0 1321 | last-cur-angle: 0 1322 | direction: none 1323 | sector: none 1324 | ;fig-start: none 1325 | ;on-detect: func [face event ][probe reduce ["detected" event/type]] 1326 | on-wheel: func [face event /local sl][ 1327 | unless face/draw/1 = 'matrix [ 1328 | insert face/draw [matrix [1 0 0 1 0 0]] 1329 | insert canvas/draw [matrix [1 0 0 1 0 0]] 1330 | ] 1331 | ;_Matrix: face/draw 1332 | select-figure 1333 | fc: face ;canvas 1334 | ev: fc/offset 1335 | ; find face offset on screen 1336 | until [fc: fc/parent ev: ev - fc/offset fc/type = 'window] 1337 | ; cursor offset on face 1338 | ev: event/offset + ev 1339 | ; current center of coordinates (COC) 1340 | dr: as-pair _Matrix/2/5 _Matrix/2/6 1341 | ; cursor offset from COC (i.e. relative to COC) 1342 | df: dr - ev 1343 | ; increased offset from COC 1344 | df+: as-pair to-integer round df/x / 1.1 to-integer round df/y / 1.1 1345 | ; decreased offset from COC 1346 | df-: as-pair to-integer round df/x * 1.1 to-integer round df/y * 1.1 1347 | ; add cursor offset to new offset 1348 | dr+: df+ + ev 1349 | dr-: df- + ev 1350 | _Matrix/2: canvas/draw/2: selection-layer/draw/2: grid-layer/draw/2: reduce [ 1351 | either 0 > event/picked [_Matrix/2/1 / 1.1][_Matrix/2/1 * 1.1] 1352 | 0 0 1353 | either 0 > event/picked [_Matrix/2/4 / 1.1][_Matrix/2/4 * 1.1] 1354 | either 0 > event/picked [dr+/x][dr-/x] 1355 | either 0 > event/picked [dr+/y][dr-/y] 1356 | ] 1357 | current-zoom/text: rejoin ["z: " round/to _Matrix/2/1 .01] 1358 | recalc-info 1359 | show [face canvas grid-layer selection-layer] 1360 | ] 1361 | on-alt-down: func [face event][ 1362 | pos1: event/offset 1363 | ;if face/draw/1 = 'matrix [ 1364 | mxpos: as-pair _Matrix/2/5 _Matrix/2/6 1365 | pos1: as-pair to-integer round pos1/x / _Matrix/2/1 to-integer round pos1/y / _Matrix/2/4 1366 | pos1: subtract pos1 mxpos / _Matrix/2/1 1367 | ;] 1368 | if drawing-on-grid? event/shift? [ 1369 | pos1/x: round/to pos1/x g-size/data/x pos1/y: round/to pos1/y g-size/data/y 1370 | ] 1371 | switch action [ 1372 | draw [ 1373 | switch figure [ 1374 | parachain [ 1375 | switch step [ 1376 | 3 or 4 [ 1377 | append selection-start 1378 | append/dup copy [polygon] 1379 | copy/part skip tail selection-start -3 2 2 1380 | reverse skip tail selection-start -2 1381 | ] 1382 | ] 1383 | ] 1384 | ] 1385 | ] 1386 | ] 1387 | ] 1388 | on-key-down: func [face event][;probe event/flags 1389 | switch event/key [ 1390 | #"M" [env/action: 'move] 1391 | #"T" [env/action: either find event/flags 'control ['t-translate]['translate] env/step: 1] 1392 | #"S" [env/action: either find event/flags 'control ['t-scale] ['scale] env/step: 1] 1393 | #"K" [env/action: 'skew env/step: 1] 1394 | #"R" [env/action: either find event/flags 'control ['t-rotate] ['rotate] env/step: 1] 1395 | delete [env/delete figs] 1396 | #"N" [env/rename figs] 1397 | #"G" [env/action: 'group] 1398 | ] 1399 | show [drawing-layer canvas figs] 1400 | ] 1401 | on-down: func [face event /local code pen type strt][;probe :face/actors/on-key-down 1402 | set-focus face 1403 | pos1: event/offset 1404 | ;if face/draw/1 = 'matrix [ 1405 | mxpos: as-pair _Matrix/2/5 _Matrix/2/6 1406 | pos1: as-pair to-integer round pos1/x / _Matrix/2/1 to-integer round pos1/y / _Matrix/2/4 1407 | pos1: subtract pos1 mxpos / _Matrix/2/1 1408 | ;] 1409 | if drawing-on-grid? event/shift? [ 1410 | pos1/x: round/to pos1/x g-size/data/x pos1/y: round/to pos1/y g-size/data/y 1411 | ] 1412 | switch action [ 1413 | draw [ 1414 | switch/default figure [ 1415 | polyline or polygon or spline [ 1416 | unless start? [ 1417 | env/step: 2 1418 | either last-action = 'insert [ 1419 | next-figure: insert next-figure pos1 1420 | ][ 1421 | append selection-start pos1 1422 | ] 1423 | ] 1424 | ] 1425 | splineC [ 1426 | unless start? [ 1427 | switch step [ 1428 | 1 [ 1429 | either last-action = 'insert [ 1430 | next-figure: insert next-figure reduce [pos1 'closed] 1431 | ][ 1432 | append selection-start reduce [pos1 'closed] 1433 | ] 1434 | env/step: 2 1435 | ] 1436 | 2 [ 1437 | either last-action = 'insert [ 1438 | next-figure: next insert back next-figure pos1 1439 | ][ 1440 | insert back tail selection-start pos1 1441 | ] 1442 | ] 1443 | ] 1444 | ] 1445 | ] 1446 | paragram [] 1447 | parachain [ 1448 | unless start? [ 1449 | switch step [ 1450 | 3 or 4 [ 1451 | ; Make new polygon from duplicated positions 3 and 4, then swap values of first two positions 1452 | append selection-start 1453 | append/dup copy [polygon] 1454 | copy/part skip tail selection-start -2 2 2 1455 | reverse skip tail selection-start -4 2 1456 | ] 1457 | ] 1458 | ] 1459 | ] 1460 | paratriple [ 1461 | unless start? [ 1462 | switch step [ 1463 | 3 [ 1464 | ; Make new polygon from duplicated positions 3 and 4, then swap values of first two positions 1465 | append selection-start 1466 | append/dup copy [polygon] 1467 | copy/part skip tail selection-start -2 2 2 1468 | reverse skip tail selection-start -4 2 1469 | append selection-start 1470 | append/dup copy [polygon] 1471 | copy/part skip tail selection-start -8 2 2 1472 | reverse skip tail selection-start -2 1473 | ] 1474 | ] 1475 | ] 1476 | ] 1477 | arc or sector [ 1478 | if step = 1 [env/step: 2] 1479 | if step = 3 [env/step: 0 start?: true] 1480 | ] 1481 | program [ 1482 | unless empty? code: write-program [ 1483 | if start? [ 1484 | either figures*/:figure [ 1485 | figures*/:figure: figures*/:figure + 1 1486 | ][ 1487 | figures*/:figure: 1 1488 | ] 1489 | ff: rejoin [figure figures*/:figure] 1490 | secondary/:ff: figure 1491 | either last-action = 'insert [ 1492 | insert figs/data ff 1493 | ][ 1494 | append figs/data ff 1495 | figs/selected: length? figs/data 1496 | ] 1497 | show figs 1498 | selected-figure/text: ff 1499 | show selected-figure 1500 | either last-action = 'insert [ 1501 | insert next-figure reduce [ 1502 | to-set-word ff do bind bind load code self env 1503 | ] 1504 | ][ 1505 | append selection-start reduce [ 1506 | to-set-word ff do bind bind load code self env 1507 | ] 1508 | ] 1509 | select-figure 1510 | redraw 1511 | start?: false 1512 | show canvas 1513 | ] 1514 | ] 1515 | ] 1516 | image [ 1517 | unless empty? imag [ 1518 | if start? [ 1519 | either figures*/:figure [ 1520 | figures*/:figure: figures*/:figure + 1 1521 | ][ 1522 | figures*/:figure: 1 1523 | ] 1524 | ff: rejoin [figure figures*/:figure] 1525 | either last-action = 'insert [ 1526 | insert figs/data ff 1527 | ][ 1528 | append figs/data ff 1529 | figs/selected: length? figs/data 1530 | ] 1531 | show figs 1532 | primary/:ff: secondary/:ff: 'image 1533 | selected-figure/text: ff 1534 | show selected-figure 1535 | 1536 | either last-action = 'insert [ 1537 | insert next-figure reduce [ 1538 | to-set-word ff 'image imag pos1 1539 | ] 1540 | ][ 1541 | append selection-start reduce [ 1542 | to-set-word ff 'image imag pos1 1543 | ] 1544 | ] 1545 | env/step: 1 1546 | select-figure 1547 | redraw 1548 | start?: false 1549 | ;show canvas 1550 | ] 1551 | ] 1552 | ] 1553 | curve or cubicCurve [if step = 1 [env/step: 2]] 1554 | text [ 1555 | unless empty? txt: ask-text [ 1556 | if start? [ 1557 | either figures*/:figure [ 1558 | figures*/:figure: figures*/:figure + 1 1559 | ][ 1560 | figures*/:figure: 1 1561 | ] 1562 | ff: rejoin [figure figures*/:figure] 1563 | secondary/:ff: figure 1564 | either last-action = 'insert [ 1565 | insert figs/data ff 1566 | ][ 1567 | append figs/data ff 1568 | figs/selected: length? figs/data 1569 | ] 1570 | show figs 1571 | selected-figure/text: ff 1572 | show selected-figure 1573 | 1574 | either last-action = 'insert [ 1575 | insert next-figure reduce [ 1576 | to-set-word ff 'text pos1 txt 1577 | ] 1578 | ][ 1579 | append selection-start reduce [ 1580 | to-set-word ff 'text pos1 txt 1581 | ] 1582 | ] 1583 | select-figure 1584 | redraw 1585 | start?: false 1586 | show canvas 1587 | ] 1588 | ] 1589 | ] 1590 | area [ 1591 | unless empty? txt: ask-long-text [ 1592 | if start? [ 1593 | either figures*/:figure [ 1594 | figures*/:figure: figures*/:figure + 1 1595 | ][ 1596 | figures*/:figure: 1 1597 | ] 1598 | ff: rejoin [figure figures*/:figure] 1599 | secondary/:ff: figure 1600 | either last-action = 'insert [ 1601 | insert figs/data ff 1602 | ][ 1603 | append figs/data ff 1604 | figs/selected: length? figs/data 1605 | ] 1606 | show figs 1607 | selected-figure/text: ff 1608 | show selected-figure 1609 | 1610 | either last-action = 'insert [ 1611 | insert next-figure reduce [ 1612 | to-set-word ff 'text pos1 txt 1613 | ] 1614 | ][ 1615 | append selection-start reduce [ 1616 | to-set-word ff 'text pos1 txt 1617 | ] 1618 | ] 1619 | select-figure 1620 | redraw 1621 | start?: false 1622 | show canvas 1623 | ] 1624 | ] 1625 | ] 1626 | ][ 1627 | start?: true 1628 | ] 1629 | ] 1630 | move [ 1631 | either find format-or-manipulation-params selection-start/1 [ 1632 | move?: false 1633 | ][ 1634 | if figure-proper: find-figure-proper [ 1635 | moveable: select figure-move-points figure-proper/1 1636 | move?: true 1637 | ] 1638 | ] 1639 | ] 1640 | ;t-rotate or t-scale [ 1641 | ; if step = 1 [selection-start/3/2: pos1] 1642 | ; env/step: 2 1643 | ;] 1644 | t-translate [ 1645 | if step = 2 [ 1646 | pre-diff: pos1 - event/offset + selection-start/3/6 ;?? last pos1? 1647 | ] 1648 | ] 1649 | pen-linear or pen-radial or pen-diamond or fill-linear or fill-radial or fill-diamond [ 1650 | set [pen type] split form action #"-" 1651 | env/current-pen: pick [fill-pen pen] pen = "fill" 1652 | env/current-type: to-word type 1653 | if find [pen-radial pen-diamond fill-radial fill-diamond] action [ 1654 | if step = 3 [poke current-gradient skip-colors + 1 pos1 redraw] 1655 | ] 1656 | ] 1657 | ;animate [ 1658 | ;if all [selection-start/2 = 'transform][ 1659 | ; probe selection-start/3: event/offset ; For rotation 1660 | ; pos1: event/offset 1661 | ;probe canvas/rate: 10 1662 | ;] 1663 | ;env/step: 2 1664 | ;] 1665 | ] 1666 | ] 1667 | on-over: func [face event /local mx pos2 draw-form ff i j pnum diff diff2 len wf][ 1668 | either drawing-on-grid? event/shift? [ 1669 | over-xy/text: rejoin ["x: " round/to event/offset/x g-size/data/x " y: " round/to event/offset/y g-size/data/y] 1670 | ][ 1671 | over-xy/text: rejoin ["x: " event/offset/x " y: " event/offset/y] 1672 | ] 1673 | recalc-info 1674 | if all [any [event/down? event/alt-down?] not find [program] figure][ 1675 | ;[start? action = 'draw event/down?];!!! 1676 | either all [start? action = 'draw event/down?][ 1677 | unless figure [figure: 'line] 1678 | "draw-form:" draw-form: switch/default figure [ 1679 | square ['box] 1680 | polyline ['line] 1681 | sector ['arc] 1682 | freehand ['line] 1683 | paragram or 1684 | parachain or 1685 | paratriple ['polygon] 1686 | ortho-grid ['box] 1687 | cubicCurve ['curve] 1688 | splineC ['spline] 1689 | ][figure] 1690 | ; Synchronize figs list ---> 1691 | either figures*/:figure [ 1692 | figures*/:figure: figures*/:figure + 1 1693 | ][ 1694 | figures*/:figure: 1 1695 | ] 1696 | ff: rejoin [figure figures*/:figure] 1697 | ; Synchronize db 1698 | primary/:ff: draw-form 1699 | secondary/:ff: figure 1700 | either last-action = 'insert [ 1701 | insert at figs/data figs/selected ff 1702 | ][ 1703 | append figs/data ff 1704 | figs/selected: length? figs/data 1705 | ] 1706 | show figs 1707 | ;<--- figs 1708 | selected-figure/text: ff 1709 | show selected-figure 1710 | either last-action = 'insert [ 1711 | next-figure: insert next-figure reduce [ 1712 | to-set-word ff 1713 | draw-form pos1 switch/default figure [ 1714 | ellipse [0x0] 1715 | circle [0] 1716 | arc sector [0x0] 1717 | ][pos1] 1718 | ] 1719 | ][ 1720 | append selection-start reduce [ 1721 | to-set-word ff 1722 | draw-form pos1 switch/default figure [ 1723 | ellipse arc sector [0x0] 1724 | circle [0] 1725 | ][pos1] 1726 | ] 1727 | ] 1728 | if find [polygon spline splineC arc sector freehand paragram parachain paratriple curve cubicCurve] figure [env/step: 1] 1729 | either last-action = 'insert [ 1730 | switch figure [ 1731 | polygon [next-figure: insert next-figure pos1] 1732 | ;spline [next-figure: insert next-figure pos1] 1733 | ;splineC [next-figure: insert next-figure reduce [pos1 'closed]] 1734 | arc [next-figure: insert next-figure [180 1]] 1735 | sector [next-figure: insert next-figure [180 1 closed]] 1736 | paragram 1737 | parachain 1738 | paratriple [next-figure: insert next-figure reduce [pos1 pos1]] 1739 | curve [next-figure: insert next-figure pos1] 1740 | cubicCurve [next-figure: insert next-figure reduce [pos1 pos1]] 1741 | ] 1742 | ][ 1743 | switch figure [ 1744 | polygon [append selection-start pos1] 1745 | ;spline [append selection-start pos1] 1746 | ;splineC [append selection-start reduce [pos1 'closed]] 1747 | arc [append selection-start [180 1]] 1748 | sector [append selection-start [180 1 closed]] 1749 | paragram or 1750 | parachain or 1751 | paratriple [append selection-start reduce [pos1 pos1]] 1752 | curve [append selection-start pos1] 1753 | cubicCurve [append selection-start reduce [pos1 pos1]] 1754 | ] 1755 | ] 1756 | select-figure/draw 1757 | ;if attempt [template/:figure] [ 1758 | ; obj/(wf: to-word ff): template/:figure 1759 | ;obj/:wf/source: next find obj/:wf/source selection-start 1760 | ;] 1761 | case [ 1762 | find [arc sector] figure [ 1763 | insert-manipulation 'rotate 1764 | selection-start/3/3: pos1 1765 | direction: 'cw 1766 | sector: 'positive 1767 | ] 1768 | figure = 'ortho-grid [ 1769 | ;probe selection-start 1770 | change/part next selection-start 1771 | append/only copy [push] 1772 | append either empty? g-step/text [ 1773 | append/only reduce ['fill-pen 'pattern g-size/data 0x0 g-size/data 'tile] 1774 | reduce ['pen 'silver 'line 0x0 as-pair 0 g-size/data/y 'line 0x0 as-pair g-size/data/x 0] 1775 | ][ 1776 | append/only reduce ['fill-pen 'pattern g-step/data * g-size/data 0x0 g-step/data * g-size/data 'tile] 1777 | collect [ 1778 | keep reduce ['pen 'gray 'line 0x0 as-pair g-step/data/x * g-size/data/x 0 'pen 'silver] 1779 | repeat i g-step/data/y - 1 [ 1780 | keep reduce ['line as-pair 0 i * g-size/data/y as-pair g-step/data/x * g-size/data/x i * g-size/data/y] 1781 | ] 1782 | keep reduce ['pen 'gray 'line 0x0 as-pair 0 g-step/data/y * g-size/data/y 'pen 'silver] 1783 | repeat i g-step/data/x - 1 [ 1784 | keep reduce ['line as-pair i * g-size/data/x 0 as-pair i * g-size/data/x g-step/data/y * g-size/data/y] 1785 | ] 1786 | ] 1787 | ] 1788 | next copy/part selection-start selection-end 1789 | selection-end 1790 | ] 1791 | ] 1792 | if select-fig/data [show-selected/new]; probe reduce ["new:" selection-layer/draw]] 1793 | start?: false 1794 | ][ 1795 | pos2: event/offset 1796 | if face/draw/1 = 'matrix [ 1797 | mxpos: as-pair _Matrix/2/5 _Matrix/2/6 1798 | pos2: as-pair to-integer round pos2/x / _Matrix/2/1 to-integer round pos2/y / _Matrix/2/4 1799 | pos2: subtract pos2 mxpos / _Matrix/2/1 1800 | ] 1801 | diff: pos2 - pos1 1802 | if drawing-on-grid? event/shift? [ 1803 | pos2/x: round/to pos2/x g-size/data/x pos2/y: round/to pos2/y g-size/data/y 1804 | ] 1805 | if pos2 <> pos-tmp [ 1806 | either event/ctrl? [ 1807 | either ortho? [ 1808 | either cx [pos2/x: cx][pos2/y: cy] 1809 | ][ 1810 | ortho?: on either lesser? absolute diff/x absolute diff/y [cx: pos1/x cy: none][cy: pos1/y cx: none] 1811 | ] 1812 | ][ 1813 | ortho?: off cx: cy: none 1814 | ] 1815 | diff: pos2 - pos1 1816 | ang: round/to 180 / pi * arctangent2/radians diff/y diff/x either drawing-on-grid? event/shift? [g-angle/data][.1] 1817 | hyp: sqrt add diff/x ** 2 diff/y ** 2 1818 | over-params/text: rejoin ["d: " diff " r: " round/to hyp .1 " α: " ang] 1819 | recalc-info 1820 | either action = 'draw [ 1821 | len: either last-action = 'insert [offset? selection-start next-figure][length? selection-start] 1822 | if event/down? [ 1823 | case [ 1824 | all [figure = 'polygon step = 1][; triangle? 1825 | poke selection-start len - 1 pos2 1826 | poke selection-start len pos2 1827 | ] 1828 | find [paragram parachain paratriple] figure [ 1829 | switch step [ 1830 | 1 [ 1831 | poke selection-start len - 2 pos2 1832 | poke selection-start len - 1 pos2 1833 | 1834 | ] 1835 | 2 [ 1836 | df: pos2 - first skip tail selection-start -3 1837 | poke selection-start len - 1 pos2 1838 | poke selection-start len df + first skip tail selection-start -4 1839 | ] 1840 | 3 4 [ 1841 | switch figure [ 1842 | parachain [ 1843 | df: pos2 - first skip tail selection-start -3 1844 | poke selection-start len - 1 pos2 1845 | poke selection-start len df + first skip tail selection-start -4 1846 | ] 1847 | paratriple [ 1848 | df: pos2 - first skip tail selection-start -8 1849 | poke selection-start len - 6 pos2 1850 | poke selection-start len - 5 df + first skip tail selection-start -9 1851 | df: pos2 - first skip tail selection-start -8 1852 | poke selection-start len - 1 pos2 ; 1853 | poke selection-start len df + first skip tail selection-start -4 1854 | ] 1855 | ] 1856 | ] 1857 | ] 1858 | ] 1859 | find [arc sector] figure [ 1860 | switch step [ 1861 | 1 [ 1862 | pre-angle: 180 + round/to 180 / pi * arctangent2/radians diff/y diff/x either drawing-on-grid? event/shift? [g-angle/data][1] ; 1863 | selection-start/3/2: 180 + round/to 180 / pi * arctangent2/radians diff/y diff/x either drawing-on-grid? event/shift? [g-angle/data][1] 1864 | last-cur-angle: 180 + round/to 180 / pi * arctangent2/radians diff/y diff/x either drawing-on-grid? event/shift? [g-angle/data][1] 1865 | selection-start/3/6: as-pair i: sqrt add power diff/x 2 power diff/y 2 i 1866 | ] 1867 | 2 [ 1868 | diff: event/offset - last-pos 1869 | cur-angle: round/to 180 / pi * arctangent2/radians diff/y diff/x either drawing-on-grid? event/shift? [g-angle/data][1] 1870 | diff2: cur-angle - pre-angle 1871 | case [ 1872 | all [last-cur-angle > 170 cur-angle < -170] [sector: pick ['negative 'positive] direction = 'cw] 1873 | all [last-cur-angle < -170 cur-angle > 170] [sector: pick ['positive 'negative] direction = 'cw] 1874 | all [pre-angle - 180 - last-cur-angle >= 0 pre-angle - 180 - cur-angle < 0] [direction: 'cw sector: 'positive] 1875 | all [pre-angle - 180 - last-cur-angle < 0 pre-angle - 180 - cur-angle >= 0] [direction: 'ccw sector: 'negative] 1876 | ] 1877 | last-cur-angle: cur-angle 1878 | poke selection-start/3 8 case [ 1879 | all [direction = 'cw sector = 'negative][540 + diff2] 1880 | all [direction = 'ccw sector = 'positive][-180 + diff2] 1881 | 'else [180 + diff2] 1882 | ] 1883 | ;selection-start/4: selection-start/4 1884 | redraw 1885 | ] 1886 | ] 1887 | ] 1888 | figure = 'program [] 1889 | figure = 'freehand [ 1890 | if pos2 <> pos1 [ 1891 | switch step [ 1892 | 1 [poke selection-start len pos2 pos1: pos2 env/step: 2] 1893 | 2 [append selection-start pos2 pos1: pos2] 1894 | ] 1895 | ] 1896 | ] 1897 | figure = 'image [ 1898 | switch step [ 1899 | 1 [append selection-start pos2 env/step: 2] 1900 | 2 [poke selection-start len pos2] 1901 | ] 1902 | ] 1903 | figure = 'ortho-grid [ 1904 | ;probe selection-start/3 1905 | poke selection-start/3 length? selection-start/3 pos2 1906 | ] 1907 | find [curve cubicCurve] figure [ 1908 | switch step [ 1909 | 1 [ 1910 | poke selection-start len pos2 1911 | ;poke selection-start len - 1 pos1 + pos2 / 2 1912 | ] 1913 | 2 [ 1914 | poke selection-start len - 1 pos2 1915 | ] 1916 | ] 1917 | ] 1918 | all [figure = 'splineC step = 2] [ 1919 | ;poke selection-start len - 2 pos2 1920 | poke selection-start len - 1 pos2 1921 | ] 1922 | 'else [ 1923 | poke selection-start len switch/default figure [ 1924 | square [dim: max diff/x diff/y pos1 + as-pair dim dim] 1925 | ellipse [diff] 1926 | circle [sqrt add power diff/x 2 power diff/y 2] 1927 | ][pos2] 1928 | ] 1929 | ] 1930 | ] 1931 | if event/alt-down? [ 1932 | case [ 1933 | find [parachain paratriple] figure [ 1934 | switch step [ 1935 | 3 or 4 [ ; Move positions positions 3 and 4 of new polygon 1936 | either figure = 'parachain [ 1937 | df: pos2 - first skip tail selection-start -3 1938 | poke selection-start len - 1 pos2 ; 1939 | poke selection-start len df + first skip tail selection-start -4 1940 | ][] 1941 | ] 1942 | ] 1943 | ] 1944 | figure = 'cubicCurve [ 1945 | if step = 2 [ 1946 | poke selection-start len - 2 pos2 1947 | ] 1948 | ] 1949 | ] 1950 | last-mode: 'alt-down 1951 | ] 1952 | select-figure/draw 1953 | ;redraw 1954 | ;show face 1955 | ][ 1956 | if event/down? [ 1957 | switch action [ 1958 | move [ 1959 | if move? [ 1960 | clear move-points 1961 | parse next figure-proper reduce [ 1962 | 'collect 'into 'move-points 1963 | either find [parachain paratriple] figure [ 1964 | [some [keep pair! | 'polygon]] 1965 | ][ 1966 | select figure-points figure-proper/1 1967 | ] 1968 | ] 1969 | if block? move-points/1 [move-points: move-points/1] 1970 | either moveable/1 = 'all [ 1971 | either find [parachain paratriple] figure [ 1972 | forall move-points [ 1973 | x: divide -1 + index? move-points 4 1974 | poke figure-proper x + 1 + index? move-points move-points/1 + diff 1975 | ] 1976 | ][ 1977 | forall move-points [poke figure-proper 1 + index? move-points move-points/1 + diff] 1978 | ] 1979 | ][ 1980 | either figure-proper/1 = 'arc [ 1981 | forall move-points [poke figure-proper -1 move-points/1 + diff poke figure-proper pick moveable index? move-points move-points/1 + diff] 1982 | ][ 1983 | forall move-points [poke figure-proper pick moveable index? move-points move-points/1 + diff] 1984 | ] 1985 | ] 1986 | pos1: pos2 1987 | ] 1988 | ] 1989 | translate [ 1990 | switch step [ 1991 | 1 [insert-manipulation action env/step: 2] 1992 | 2 [selection-start/3/2: diff] 1993 | ] 1994 | ] 1995 | scale [ 1996 | switch step [ 1997 | 1 [insert-manipulation action env/step: 2] 1998 | 2 [ 1999 | selection-start/3/2: add 1 diff/x / 100.0 2000 | selection-start/3/3: add 1 diff/y / 100.0 2001 | ] 2002 | ] 2003 | ] 2004 | skew [ 2005 | switch step [ 2006 | 1 [insert-manipulation action env/step: 2] 2007 | 2 [ 2008 | selection-start/3/2: diff/x 2009 | selection-start/3/3: diff/y 2010 | ] 2011 | ] 2012 | ] 2013 | rotate [ 2014 | switch step [ 2015 | 1 [insert-manipulation action selection-start/3/3: pos1 env/step: 2] 2016 | 2 [ 2017 | selection-start/3/2: round/to 180 / pi * arctangent2/radians diff/y diff/x 2018 | either drawing-on-grid? event/shift? [g-angle/data][.1] 2019 | ] 2020 | ] 2021 | ] 2022 | t-rotate [ 2023 | switch step [ 2024 | 1 [new-transformation selection-start/3/2: pos1 env/step: 2] 2025 | 2 [ 2026 | selection-start/3/3: round/to 180 / pi * arctangent2/radians diff/y diff/x 2027 | either drawing-on-grid? event/shift? [g-angle/data][.1] 2028 | ] 2029 | ] 2030 | ] 2031 | t-scale [ 2032 | switch step [ 2033 | 1 [new-transformation selection-start/3/2: pos1 env/step: 2] 2034 | 2 [ 2035 | selection-start/3/4: add 1 diff/x / 100.0 2036 | selection-start/3/5: add 1 diff/y / 100.0 2037 | ] 2038 | ] 2039 | ] 2040 | t-translate [ 2041 | switch step [ 2042 | 1 [new-transformation selection-start/3/2: pos1 env/step: 2] 2043 | 2 [selection-start/3/6: diff + pre-diff] 2044 | ] 2045 | ] 2046 | ;animate [ 2047 | ; if all [step = 2 canvas/rate] [ 2048 | ; canvas/rate: either 0 < diff/x [canvas/rate + diff/x][0:0:1 + divide absolute diff/x 10] 2049 | ; ] 2050 | ;] 2051 | pen-linear or 2052 | pen-radial or 2053 | pen-diamond or 2054 | fill-linear or 2055 | fill-radial or 2056 | fill-diamond [ 2057 | switch step [ 2058 | 1 [ 2059 | set-gradient current-pen current-type pos1 env/step: 2 2060 | env/current-gradient: find/last selection-start/3 current-pen 2061 | ] 2062 | 2 [ 2063 | poke current-gradient skip-colors switch current-type [ 2064 | linear [pos2] 2065 | radial [hyp] 2066 | diamond [pos2] 2067 | ] 2068 | ] 2069 | 3 [poke current-gradient skip-colors + 1 pos2] 2070 | ] 2071 | ] 2072 | ] 2073 | last-mode: 'down 2074 | ] 2075 | ] 2076 | ;if attempt [template/:figure] [ 2077 | ; obj/(wf: to-word ff): template/:figure 2078 | ;obj/:wf/source: next find obj/:wf/source selection-start 2079 | ;] 2080 | if select-fig/data [show-selected] 2081 | ] 2082 | pos-tmp: pos2 2083 | ] 2084 | redraw 2085 | ] 2086 | ] 2087 | on-alt-up: func [face][ 2088 | switch action [ 2089 | draw [ 2090 | switch figure [ 2091 | parachain [ 2092 | switch step [ 2093 | 3 [env/last-step: step env/step: step + 1] 2094 | 4 [env/last-step: 4] 2095 | ] 2096 | ] 2097 | ] 2098 | ] 2099 | ] 2100 | ] 2101 | on-up: func [face][ 2102 | if all [last-action = 'insert not find [polygon polyline paragram parachain paratriple spline splineC] figure] [last-action: none] 2103 | switch action [ 2104 | t-rotate [env/step: 1] 2105 | draw [ 2106 | switch figure [ 2107 | arc or sector [ 2108 | if step = 2 [env/step: 3] 2109 | ] 2110 | image [env/step: 0 start?: true show face] ; In case image was set by a click, i.e. without on-over 2111 | paragram [ 2112 | switch step [ 2113 | 1 [env/step: 2] 2114 | 2 [env/step: 0 env/start?: true env/action: 'draw] 2115 | ] 2116 | ] 2117 | parachain [ 2118 | switch step [ 2119 | 1 or 2 or 3 [env/last-step: step env/step: step + 1] 2120 | 4 [env/last-step: 4] 2121 | ] 2122 | ] 2123 | paratriple [ 2124 | switch step [ 2125 | 1 or 2 [env/last-step: step env/step: step + 1] 2126 | 3 [env/step: 0 env/start?: true env/action: 'draw] 2127 | ] 2128 | ] 2129 | ] 2130 | if edit/data [edit-selection/new] 2131 | ] 2132 | pen-radial or pen-diamond or fill-radial or fill-diamond [if step = 2 [env/step: 3]] 2133 | ] 2134 | last-pos: pos1 2135 | ;probe canvas/draw 2136 | ;env/win/selected: face show win ;?? 2137 | ] 2138 | ] 2139 | ] 2140 | ;at 0x0 drawing-bg: box white ;230.230.235 2141 | layer1: layer 255.255.255.0 with [ 2142 | actors: object [ 2143 | on-time: func [face event /local r-center angle scale-x scale-y translate][ 2144 | ;if all [action = 'animate step = 2 selection-start/2 = 'transform] [ 2145 | ; selection-start/4: anim-step: anim-step + 1 2146 | ; show face 2147 | ;] 2148 | do bind bind load animations self env 2149 | show canvas 2150 | ] 2151 | ] 2152 | ] 2153 | do [ 2154 | env/canvas: layer1 2155 | selection-start: at canvas/draw 2 2156 | selection-end: tail canvas/draw 2157 | ] 2158 | ;at 0x0 edit-panel: panel 0.0.0.254 [ 2159 | ;origin 0x0 space 0x0 2160 | at 0x0 selection-layer: box hidden with [ 2161 | draw: [matrix [1 0 0 1 0 0] [line-join bevel line-width 2 pen 80.150.255]] 2162 | ] 2163 | at 0x0 grid-layer: box hidden with [ 2164 | draw: append append/only append [matrix [1 0 0 1 0 0] pen off fill-pen pattern] env/g-size/data 2165 | [fill-pen cyan circle 0x0 .5] append [box 0x0] canvas/size 2166 | ] 2167 | at 0x0 drawing-layer: drawing focus transparent 2168 | do [_Matrix: drawing-layer/draw] 2169 | at 0x0 edit-layer: base 300x300 transparent all-over hidden 2170 | extra object [pos1: 0x0 pos2: 0x0 size: 0x0] 2171 | on-down [;probe "down" 2172 | either event/shift? [ 2173 | 2174 | ][ 2175 | foreach-face face [face/draw/4: 'transparent] 2176 | ] 2177 | face/extra/pos1: face/extra/pos2: event/offset 2178 | show face 2179 | ] 2180 | on-over [ 2181 | either event/down? [ 2182 | if 4 > absolute face/extra/pos2/x - event/offset/x [ ; To avoid a quirk when moving over control point - event/offset value jumps up 2183 | face/extra/pos2: event/offset 2184 | face/extra/size: absolute face/extra/pos2 - face/extra/pos1 2185 | ;probe reduce [face/extra/pos1 face/extra/pos2 face/extra/size] 2186 | foreach-face/with face [ 2187 | face/draw/4: 80.150.255 2188 | ][ 2189 | within? face/offset + 5x5 min face/parent/extra/pos1 face/parent/extra/pos2 face/parent/extra/size 2190 | ] 2191 | unless event/shift? [ 2192 | foreach-face/with face [ 2193 | face/draw/4: 'transparent 2194 | ][ 2195 | not within? face/offset + 5x5 min face/parent/extra/pos1 face/parent/extra/pos2 face/parent/extra/size 2196 | ] 2197 | ] 2198 | ] 2199 | ][ 2200 | ] 2201 | show face 2202 | ] 2203 | on-up [ 2204 | either event/shift? [][ 2205 | ] 2206 | ] 2207 | ;on-alt-down [do-actor drawing-layer event 'alt-down] 2208 | ;on-alt-up [do-actor drawing-layer event 'alt-up] 2209 | with [pane: copy []] 2210 | ;] 2211 | ] 2212 | ;return 2213 | figs-panel: panel snow 100x380 [ 2214 | style fig-list: text-list 100x300 data [] ;265 2215 | with [ 2216 | menu: [ 2217 | "Format" [ 2218 | "Line" [ 2219 | "Width" line-width 2220 | "Join" line-join 2221 | "Cap" line-cap 2222 | ] 2223 | "Pen" [ 2224 | "Color" pen 2225 | "Linear" pen-linear 2226 | "Radial" pen-radial 2227 | "Diamond" pen-diamond 2228 | ; "Pattern" pen-pattern 2229 | ; "Bitmap" pen-bitmap 2230 | ; "Off" pen-off 2231 | ] 2232 | "Fill" [ 2233 | "Color" fill 2234 | "Linear" fill-linear 2235 | "Radial" fill-radial 2236 | "Diamond" fill-diamond 2237 | ; "Pattern" fill-pattern 2238 | ; "Bitmap" fill-bitmap 2239 | ; "Off" fill-off 2240 | ] 2241 | ;"Anti-alias" anti-alias 2242 | ] 2243 | "Move-z" [ 2244 | "Back" back 2245 | "Backward" backward 2246 | "Forward" forward 2247 | "Front" front 2248 | "---" 2249 | "Before" before 2250 | "Swap" swap 2251 | ] 2252 | "Move (M)" move 2253 | "Manipulate" [ 2254 | "Translate (T)" translate 2255 | "Scale (S)" scale 2256 | "Skew (K)" skew 2257 | "Rotate (R)" rotate 2258 | ; "Undo last" undo-manipulation ; TBD Delete latest manipulation 2259 | ; "Undo all" undo-manipulations ; TBD Delete all manipulations 2260 | ] 2261 | "Transform" [ 2262 | "Translate (Ctrl-T)" t-translate 2263 | "Scale (Ctrl-S)" t-scale 2264 | "Rotate (Ctrl-R)" t-rotate 2265 | "Undo" [ 2266 | "Rotate" undo-t-rotate 2267 | "Scale" undo-t-scale 2268 | "Translate" undo-t-translate 2269 | "All" undo-transforms 2270 | ] 2271 | ];"---" 2272 | ;"Show transformations" show-transform ; TBD Show in separate window (like group elements), from where they can be edited 2273 | ;"Hide transformations" hide-transform ; TBD 2274 | ;"Animate" [ 2275 | ; "Translate" a-translate 2276 | ; "Scale" a-scale 2277 | ; "Skew" a-skew 2278 | ; "Rotate" a-rotate 2279 | ;] 2280 | ;"Stop" stop-animation 2281 | "Grouping" [ 2282 | "Group" group 2283 | "Show elements" show-group 2284 | "Hide elements" hide-group 2285 | ; "Ungroup" ungroup ; TBD Remove group transformations and replace group with elementary contents 2286 | ] 2287 | ;"Insert" insert ;?? New one just before current one; TBD 2288 | "Clone" clone 2289 | "Rename (N)" rename 2290 | "Delete (Del)" delete 2291 | ;"3D" [ 2292 | ; "Rotate" ["x" d3-x-rotate "y" d3-y-rotate "z" d3-z-rotate] ; TBD 2293 | ; "Translate" ["x" d3-x-translate "y" d3-y-translate "z" d3-z-translate] ; TBD 2294 | ;] 2295 | ] 2296 | actors: object [ 2297 | pos: 0x0 2298 | last-selected: none 2299 | last-length: none 2300 | last-tail: none 2301 | ;on-down: func [face event][ 2302 | ; pos: event/offset 2303 | ;] 2304 | on-wheel: func [face event][event/flags 2305 | either find event/flags 'control [ 2306 | move-selection pick [backward forward] 0 < event/picked 2307 | ][ 2308 | switch event/picked [ 2309 | 1 [unless face/selected = 1 [face/selected: face/selected - 1]] 2310 | -1 [unless face/selected = length? face/data [face/selected: face/selected + 1]] 2311 | ] 2312 | show face 2313 | select-figure 2314 | ] 2315 | ] 2316 | on-menu: func [face event /local sel elements point figure][ 2317 | env/action: 'draw 2318 | switch event/picked [ 2319 | line-width [env/format: pen-width/data env/action: 'line-width] 2320 | line-join or 2321 | line-cap [env/action: event/picked] 2322 | 2323 | pen or 2324 | pen-linear or 2325 | pen-radial or 2326 | pen-diamond or 2327 | fill or 2328 | fill-linear or 2329 | fill-radial or 2330 | fill-diamond [env/format: color env/action: event/picked env/step: 1] 2331 | 2332 | pen-pattern [] 2333 | pen-bitmap [] 2334 | pen-off [] 2335 | 2336 | fill-pattern [] 2337 | fill-bitmap [] 2338 | fill-off [] 2339 | 2340 | anti-alias [] 2341 | 2342 | back [move-selection 'back] 2343 | backward [move-selection 'backward] 2344 | forward [move-selection 'forward] 2345 | front [move-selection 'front] 2346 | before [env/action: 'before] 2347 | swap [env/action: 'swap] 2348 | 2349 | move [env/action: 'move] 2350 | translate or scale or skew or rotate [env/action: event/picked env/step: 1];[new-manipulation event/picked] 2351 | undo-manipulation [] 2352 | undo-manipulations [] 2353 | t-rotate or t-scale or t-translate [env/action: event/picked env/step: 1];[new-transformation event/picked] 2354 | undo-t-rotate or ;[if all [selection-start/2 = 'push found: find selection-start/3 'transform][found/2: 0x0 found/3: 0] show canvas] 2355 | undo-t-scale or ;[if all [selection-start/2 = 'push found: find selection-start/3 'transform][found/4: found/5: 1] show canvas] 2356 | undo-t-translate or ;[if all [selection-start/2 = 'push found: find selection-start/3 'transform][found/6: 0x0] show canvas] 2357 | undo-transforms [ 2358 | if all [ 2359 | selection-start/2 = 'push 2360 | found: find selection-start/3 'transform 2361 | ][ 2362 | switch event/picked [ 2363 | undo-t-rotate [found/2: 0x0 found/3: 0] 2364 | undo-t-scale [found/4: found/5: 1] 2365 | undo-t-translate [found/6: 0x0] 2366 | undo-transforms [change next found [0x0 0 1 1 0x0]] 2367 | ] 2368 | ] 2369 | redraw ;show canvas 2370 | ] 2371 | ;animate [env/action: 'animate env/step: 1 canvas/rate: 10] 2372 | stop-animation [canvas/rate: none env/step: 1] 2373 | 2374 | a-translate [ 2375 | unless selection-start/3/1 <> 'translate [ 2376 | insert-manipulation 'translate ;new-manipulation 'translate ??? 2377 | ] 2378 | ] 2379 | 2380 | group [env/action: 'group] 2381 | show-group [ 2382 | if elements: parse next selection-start show-group-rule [ 2383 | group/data: elements 2384 | group/size/y: min 20 * length? elements 240 2385 | face/size/y: face/parent/size/y - face/offset/y - group/size/y - sep2/size/y 2386 | sep2/offset/y: figs1/offset/y + figs1/size/y 2387 | group/offset: as-pair face/offset/x face/offset/y + face/size/y + sep2/size/y 2388 | sep2/visible?: yes 2389 | group/visible?: yes 2390 | show group show face show sep2 2391 | ] 2392 | ] 2393 | hide-group [ 2394 | foreach fig next find figs-panel/pane figs [ 2395 | fig/visible?: no 2396 | ] 2397 | figs1/size/y: figs1/parent/size/y - figs1/offset/y 2398 | show figs-panel 2399 | ] 2400 | ungroup [ 2401 | ;either block? selection-start/2 [;probe selection-start/2 2402 | replace face/data pick face/data face/selected parse next selection-start show-group-rule 2403 | selection-end: offset? selection-start selection-end 2404 | change/part selection-start unwrap-group selection-end ; first get to-word selection-start/1 2405 | select-figure 2406 | show [face canvas] 2407 | ;][ 2408 | ; show-warning 2409 | ; either find [transform translate scale skew rotate] selection-start/2 [ 2410 | ; "Please remove transformations first!" 2411 | ; ][ 2412 | ; "This is not a group!" 2413 | ; ] 2414 | ;] 2415 | ] ; TBD 2416 | rename [env/rename face] 2417 | insert [ 2418 | env/last-action: 'insert 2419 | next-figure: selection-start 2420 | ] 2421 | clone [ 2422 | figure: select secondary pick figs/data figs/selected 2423 | figures*/:figure: figures*/:figure + 1 2424 | ff: rejoin [figure figures*/:figure] 2425 | primary/:ff: select primary pick figs/data figs/selected 2426 | secondary/:ff: figure 2427 | append selection-start append reduce [to-set-word ff] copy/deep/part next selection-start selection-end 2428 | append figs/data ff 2429 | figs/selected: length? figs/data 2430 | show figs 2431 | select-figure 2432 | selected-figure/text: ff 2433 | show selected-figure 2434 | if select-fig/data [show-selected/new] 2435 | redraw 2436 | ] 2437 | delete [env/delete face] 2438 | d3 [new-transformation event/picked] 2439 | ] 2440 | current-action/text: form action 2441 | recalc-info 2442 | ] 2443 | on-down: func [face event][env/figs: face] 2444 | on-select: func [face event][ 2445 | switch action [ 2446 | group [last-selected: face/selected] 2447 | before or swap [ 2448 | last-selected: face/selected 2449 | last-length: figure-length 2450 | ] 2451 | ] 2452 | ] 2453 | on-change: func [face event /local new-selected new-group][ 2454 | switch/default action [ 2455 | group [ 2456 | new-selected: find-figure/tail face/selected 2457 | either figures*/group [figures*/group: figures*/group + 1][figures*/group: 1] 2458 | new-group: rejoin ['group figures*/group] 2459 | change/part selection-start 2460 | append/only 2461 | copy reduce [to-set-word new-group] 2462 | copy/part selection-start new-selected ;/copy/deep ?? 2463 | new-selected 2464 | change/part at face/data last-selected new-group face/selected - last-selected + 1 2465 | face/selected: last-selected 2466 | select-figure 2467 | show face show canvas 2468 | env/action: 'draw 2469 | ] 2470 | before [ 2471 | move-selection/from/to 'before last-selected face/selected 2472 | show face show canvas 2473 | env/action: 'draw 2474 | ] 2475 | swap [ 2476 | move-selection/from/to 'swap last-selected face/selected 2477 | show face show canvas 2478 | env/action: 'draw 2479 | ] 2480 | ][select-figure] 2481 | ] 2482 | ] 2483 | ] 2484 | style sep: box loose 30x10 hidden 2485 | draw [pen gray line 0x4 30x4 line 0x6 30x6] 2486 | on-drag [ 2487 | face/offset/x: 35 2488 | idx: index? find face/parent/pane face 2489 | prev: face/parent/pane/(idx - 1) 2490 | nex: face/parent/pane/(idx + 1) 2491 | tot: 0 2492 | foreach-face/with figs-panel [tot: tot + face/size/y][face/visible? = yes];prev/size/y + face/size/y + nex/size/y 2493 | prev/size/y: face/offset/y - prev/offset/y 2494 | nex/offset/y: face/offset/y + face/size/y 2495 | nex/size/y: tot - prev/size/y - face/size/y 2496 | show figs-panel 2497 | ] 2498 | at 0x0 layers: text-list 100x30 hidden data ["layer1"] 2499 | with [ 2500 | extra: 'layers 2501 | menu: [ 2502 | "Move-z" [ 2503 | "Back" back 2504 | "Backward" backward 2505 | "Forward" forward 2506 | "Front" front 2507 | "---" 2508 | "Before" before 2509 | "Swap" swap 2510 | ] 2511 | "Toggle visibility" visible 2512 | "Background" background 2513 | ;"Clone" clone 2514 | "Rename" rename 2515 | "Delete" delete 2516 | ] 2517 | actors: object [ 2518 | last-selected: none 2519 | on-wheel: func [face event][ 2520 | move-layer pick [backward forward] 0 < event/picked 2521 | ] 2522 | on-select: func [face event][last-selected: face/selected] 2523 | on-change: func [face event /local new-selected new-group][ 2524 | switch/default action [ 2525 | before [ 2526 | move-layer/from/to 'before last-selected face/selected 2527 | ;show [drawing-panel figs-panel] 2528 | env/action: 'draw 2529 | ] 2530 | swap [ 2531 | move-layer/from/to 'swap last-selected face/selected 2532 | ;show [drawing-panel figs-panel] 2533 | env/action: 'draw 2534 | ] 2535 | ][select-layer] 2536 | ] 2537 | on-menu: func [face event /local sel new-name name][ 2538 | switch event/picked [ 2539 | back [move-layer 'back] 2540 | backward [move-layer 'backward] 2541 | forward [move-layer 'forward] 2542 | front [move-layer 'front] 2543 | before [env/action: 'before] 2544 | swap [env/action: 'swap] 2545 | visible [ 2546 | sel: face/selected 2547 | drawing-panel/pane/:sel/visible?: not drawing-panel/pane/:sel/visible? 2548 | show drawing-panel 2549 | ] 2550 | background [ 2551 | env/format: env/color 2552 | env/action: 'background 2553 | ;select-color 2554 | ] 2555 | rename [ 2556 | new-name: ask-new-name 2557 | either find face/data new-name [ 2558 | show-warning "Name should be unique!" 2559 | ][ 2560 | do reduce [ 2561 | to-set-word new-name to-get-word name: pick face/data face/selected 2562 | unset to-lit-word name 2563 | ] 2564 | change at face/data face/selected new-name 2565 | show face 2566 | ] 2567 | ] 2568 | delete [ 2569 | remove at drawing-panel/pane face/selected 2570 | sel: either face/selected = length? face/data [face/selected - 1][face/selected] 2571 | remove at face/data face/selected 2572 | face/selected: sel 2573 | env/canvas: get to-word pick face/data face/selected 2574 | figs/data: canvas/extra/figs 2575 | show [drawing-panel figs-panel] 2576 | ] 2577 | ] 2578 | ] 2579 | ] 2580 | ] 2581 | at 35x0 sep1: sep 2582 | at 0x0 figs1: fig-list with [extra: 'figs1] do [env/figs: figs1 env/canvas/extra/figs: figs/data] 2583 | at 35x0 sep2: sep 2584 | at 0x0 group: fig-list with [extra: 'group] hidden 2585 | at 35x0 sep3: sep 2586 | at 0x0 subgroup: fig-list with [extra: 'subgroup] hidden 2587 | at 35x0 sep4: sep 2588 | at 0x0 subgroup2: fig-list with [extra: 'subgroup2] hidden 2589 | ;across space 1x10 2590 | ;button 25x25 with [image: (draw 23x23 [fill-pen black polygon 10x17 12x17 12x8 14x8 11x5 8x8 10x8])][ 2591 | 2592 | ;] 2593 | ;button 25x25 with [image: (draw 23x23 [fill-pen black polygon 10x5 12x5 12x14 14x14 11x17 8x14 10x14])] 2594 | ] 2595 | return 2596 | at 100x390 anim-panel: panel snow 360x25 [ 2597 | origin 0x0 space 4x0 2598 | text 30x23 "Rate:" a-rate: field 30x23 with [data: 10][canvas/rate: face/data] 2599 | button "Animate" [ 2600 | insert clear body-of :env/canvas/actors/on-time [tick: tick + 1] 2601 | append body-of :env/canvas/actors/on-time bind bind bind append load animations/text [show face] :env/canvas/actors/on-time env/canvas/actors env 2602 | canvas/rate: a-rate/data 2603 | show canvas 2604 | ;append canvas/draw clear [] 2605 | ] 2606 | button "Stop" [canvas/rate: none] 2607 | button "Continue" [canvas/rate: a-rate/data show canvas] 2608 | ] 2609 | ;] 2610 | ] 2611 | "Animation" [ 2612 | ;animations: area 520x420 2613 | origin 0x0 space 0x0 2614 | animations: area 519x421 ;!!! 2615 | ] 2616 | "Scenes" [ 2617 | ;scenes: none 2618 | ] 2619 | ] 2620 | do [foreach tab tab-pan/pane [tab/parent/offset tab/offset: tab/parent/offset + 10x30]];2x24]];[drawing-panel-tab: pane/1/pane/1 animations-panel-tab: pane/1/pane/2] 2621 | ][ 2622 | menu: [ 2623 | "File" [ 2624 | "New" new 2625 | "Open" open 2626 | "Save" save 2627 | "Save as .." save-as 2628 | "Export layer as .." export 2629 | ] 2630 | "View" ["Draw window" draw "Draw console" console] 2631 | "Help" help 2632 | ] 2633 | actors: object [ 2634 | save-file-as: does [ 2635 | win/extra: request-file/save 2636 | save-file 2637 | win/text: to-local-file last split-path win/extra 2638 | show win 2639 | ] 2640 | save-file: does [save win/extra append/only insert/only next [draw animations] canvas/draw animations/text] 2641 | on-menu: func [face event /local loaded][ 2642 | switch event/picked [ 2643 | open [ 2644 | win/extra: request-file 2645 | loaded: load win/extra 2646 | canvas/draw: select loaded 'draw 2647 | animations/text: select loaded 'animations 2648 | win/text: to-local-file last split-path win/extra 2649 | redraw 2650 | figs/data: parse canvas/draw show-figs-rule 2651 | figs/selected: 1 2652 | select-figure 2653 | show win;[canvas figs animations] 2654 | ] 2655 | save [either win/extra [save-file][save-file-as]] 2656 | save-as [save-file-as] 2657 | draw [show-draw] 2658 | console [show-console] 2659 | export [save file: request-file/save/file/filter %export.png ["png" "*.png" "jpeg" "*.jpg" "gif" "*.gif"] draw canvas/size canvas/draw] 2660 | help [ 2661 | view/flags [ 2662 | text "See Readme:" field 300x24 "https://github.com/toomasv/drawing/blob/master/README.md" return 2663 | text 500x450 {Just few notes for current version: To draw simple figures click on canvas and drag. To draw "poly-" figures (polyline and polygon) click and drag first line, then release and click and drag again to add lines. For manipulations (inserts separate `translate`, `scale`, `skew` and `rotate`) and transformations (inserts single `transform`) click and drag: 2664 | 2665 | * for rotation, click sets the rotation center, drag creates "lever" (preferably drag initially away from center in 0 direction, i.e to right) to rotate the figure 2666 | * for scaling, click sets the start of scaling, drag scales in relation to 0x0 coordinates (I will implement "local" scaling, i.e. in relation to coordinates set by click) 2667 | * for skewing, again, click sets start, drag skews in relation to 0x0 (intend to implement "local" skewing) 2668 | * for translation, click sets start, drag translates. 2669 | 2670 | Holding down control-key while drawing, switches on `ortho` mode, resulting in orthogonal (vertical or horizontal) lines. (As an interesting effect, if you hold control-key down while starting new line *after drawing an orthogonal line* the new line is drawn from starting point orthogonally to the last line. To avoid this, start line in normal mode and press `control` only after starting. I have not decided yet whether to consider this as a bug or as a feature.) 2671 | 2672 | Sift-key controls the grid-mode. If "Grid" is not checked, holding down `shift` switches grid-mode temporarily on, if it is checked, `shift` switches it temporarily off. Grid steps can be changed on edit-options-panel. (In second field, grid for angles is set (arc degrees to step)). 2673 | 2674 | Wheel-rotation zooms in and out. New figures are inserted correctly under cursor in zoomed views. 2675 | 2676 | Pictures are inserted either from web (paste url into field) or from local file-system. First click after "OK" on file-selection window sets the top-left position for the picture, second click inserts picture - or - click and drag inserts picture to dragged dimensions. (Some bug, which I haven't succeeded to weed out, requires two mouse presses, instead of one. Working on this.) 2677 | } text 500x450 { 2678 | Wheel rotation above figures-list on right now moves the selected figure up or down in z-order. 2679 | 2680 | Local formatting for figures can be now selected from contextual menu on figures-list. E.G. to change pen color, select `Format->Pen->Color` and then select color from left side pen-color-picker. 2681 | 2682 | Draw-block can be seen/copied/edited by clicking "View->Draw window" (opens window with draw-block) or "View->Draw console" (makes VID code which may be pasted into console with `do [..]`) on main menu. 2683 | 2684 | To play with animations, you have to: 2685 | 2686 | * first insert transformation (not manipulation!) for the figure, i.e. select figure and from menu select transformation and then click on canvas to set it (take eg. Transform->Translate", click on canvas and drag jst a little bit, relase), 2687 | * then add animation descriptions to the "Animation" tab (print figure name, slash, 2, slash, number of , i.e number according to transformation syntax. 2688 | 2689 | Can also use this: 2690 | 2691 | ``` 2692 | set [r-center angle scale-x scale-y translate][2 3 4 5 6] 2693 | square1/2/:angle: tick 2694 | ``` 2695 | 2696 | to change angle (i.e. nimate rotation); `tick` is preset reserved word counting time ticks, 2697 | * click "Animate" button on "Drawing" tab 2698 | 2699 | } 2700 | button "OK" [unview] 2701 | ][modal popup] 2702 | ] 2703 | ] 2704 | ] 2705 | on-resizing: func [face event][ 2706 | ;tab-pan/offset: 10x10 2707 | tab-pan/size: win/size - 20;17 2708 | foreach tab tab-pan/pane [ 2709 | ;tab/offset: tab/parent/offset + 2x24;! 2710 | tab/size: tab/parent/size - 4x25;! 2711 | ;tab/size: tab/parent/size; - 10;23x45 2712 | ] 2713 | ;drawing-panel-tab/offset: 10x10 2714 | ;drawing-panel-tab/size: drawing-panel-tab/parent/size - 4x20 2715 | ;info-panel/size/y: info-panel/parent/size/y - info-panel/offset/y - 10 2716 | info-panel/size/x: info-panel/parent/size/x - info-panel/offset/x - 10 ; ! 2717 | edit-options-panel/size/x: edit-options-panel/parent/size/x - edit-options-panel/offset/x - 10;! 2718 | options-panel/size/y: options-panel/parent/size/y - options-panel/offset/y - 10 2719 | drawing-panel/size: ;edit-panel/size: 2720 | drawing-panel/parent/size - drawing-panel/offset - 120x50 2721 | foreach-face drawing-panel [face/size: drawing-panel/size] 2722 | canvas/size: drawing-panel/size ; grid-layer/size: selection-layer/size: drawing-layer/size: 2723 | poke grid-layer/draw length? grid-layer/draw canvas/size 2724 | figs-panel/offset/x: figs-panel/parent/size/x - 110 2725 | figs-panel/size/y: figs-panel/parent/size/y - figs-panel/offset/y - 10;15 2726 | figs1/size/y: figs-panel/size/y 2727 | anim-panel/offset/x: drawing-panel/offset/x;anim-panel/parent/offset/x + 100 2728 | anim-panel/offset/y: anim-panel/parent/size/y - 35;38 2729 | anim-panel/size/x: drawing-panel/size/x 2730 | ;animations/offset: 0x0 2731 | animations/size: animations/parent/size ;- 1x0;5x25 2732 | show win 2733 | ] 2734 | ] 2735 | ] 2736 | view/flags win [resize] ; /no-wait 2737 | ;view/flags win [resize] 2738 | ;do-events 2739 | ] 2740 | -------------------------------------------------------------------------------- /ellipse-draw.red: -------------------------------------------------------------------------------- 1 | draw [matrix [1 0 0 1 15 10] 2 | circle1: circle 180x170 160.0 3 | line1: push [pen blue line 20x170 340x170] 4 | line2: push [pen green line 180x10 180x330] 5 | ellipse2: push [pen papaya ellipse 60x130 240x80] 6 | group1: push [ 7 | rotate -46439 180x170 8 | rotate 92878 260x170 [ 9 | circle2: circle 260x170 80.0 10 | line3: push [ 11 | line-cap round 12 | pen mint 13 | line-width 8 14 | line 180x170 340x170 15 | ] 16 | line-width 1 17 | circle3: push [ 18 | fill-pen papaya 19 | pen papaya 20 | circle 299x170 1.0 21 | ]] ] ] 22 | animations { 23 | group1/2/5: tick * 2 24 | group1/2/2: negate tick 25 | } -------------------------------------------------------------------------------- /frame-with-picture_1f5bc.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/toomasv/drawing/ae41a6bd3e4c3e1c47734e9f311d5ad497b8cb4d/frame-with-picture_1f5bc.png -------------------------------------------------------------------------------- /layout.red: -------------------------------------------------------------------------------- 1 | Red [] 2 | context [ 3 | env: self 4 | canvas: none 5 | tab-pan: drawing-panel-tab: animations: none 6 | info-panel: edit-options-panel: options-panel: drawing-panel: figs-panel: anim-panel: none 7 | layer: layer1: drawing: selection-layer: grid-layer: drawing-layer: edit-layer: none 8 | win: layout/options compose/deep [ 9 | title "Drawing pad" 10 | size 540x465 11 | tab-pan: tab-panel 520x445 [ 12 | "Drawing" [;backdrop rebolor 13 | across 14 | info-panel: panel 500x25 gold [origin 0x0 space 4x0] 15 | return 16 | edit-options-panel: panel 500x25 brick [origin 0x0 space 4x0] 17 | return 18 | options-panel: panel 80x335 water [origin 0x0 space 0x0] 19 | drawing-panel: panel 300x300 snow [ 20 | origin 0x0 space 0x0 21 | style layer: box glass ;draw [] 22 | style drawing: base glass 300x300 23 | layer1: layer ;255.255.255.0 24 | do [env/canvas: layer1] 25 | at 0x0 selection-layer: box hidden 26 | at 0x0 grid-layer: box hidden 27 | at 0x0 drawing-layer: drawing ;transparent 28 | at 0x0 edit-layer: base 300x300 transparent hidden 29 | ] 30 | figs-panel: panel 100x335 beige [] 31 | return 32 | at 100x390 anim-panel: panel 300x25 crimson [origin 0x0 space 4x0] 33 | ] 34 | "Animation" [origin 0x0 space 0x0 35 | animations: area 517x421 36 | ] 37 | ] 38 | do [ 39 | drawing-panel-tab: pane/1/pane/1 40 | animations-panel-tab: pane/1/pane/2 41 | ] 42 | ][ 43 | actors: object [ 44 | on-resizing: func [face event][ 45 | tab-pan/size: win/size - 20;x17 46 | foreach tab tab-pan/pane [ 47 | tab/offset: tab/parent/offset + 2x24 48 | tab/size: tab/parent/size - 5x27 49 | ] 50 | info-panel/size/x: info-panel/parent/size/x - info-panel/offset/x - 10 51 | edit-options-panel/size/x: edit-options-panel/parent/size/x - edit-options-panel/offset/x - 10 52 | options-panel/size/y: options-panel/parent/size/y - options-panel/offset/y - 10 53 | drawing-panel/size: drawing-panel/parent/size - drawing-panel/offset - 120x45 54 | foreach-face drawing-panel [face/size: drawing-panel/size] 55 | canvas/size: drawing-panel/size ; grid-layer/size: selection-layer/size: drawing-layer/size: 56 | ;poke grid-layer/draw length? grid-layer/draw canvas/size 57 | figs-panel/offset/x: figs-panel/parent/size/x - 110 58 | figs-panel/size/y: figs-panel/parent/size/y - figs-panel/offset/y - 10 59 | ;figs1/size/y: figs-panel/size/y 60 | anim-panel/offset/x: drawing-panel/offset/x 61 | anim-panel/offset/y: anim-panel/parent/size/y - 35 62 | anim-panel/size/x: drawing-panel/size/x 63 | animations/size: animations/parent/size - 1x0 64 | ;show win 65 | ] 66 | ] 67 | ] 68 | view/flags win [resize] 69 | ;view win 70 | ] 71 | 72 | -------------------------------------------------------------------------------- /quadratic-bezier-draw.red: -------------------------------------------------------------------------------- 1 | draw [matrix [1.0 0 0 1.0 0 0] 2 | polygon1: polygon 30x310 100x110 320x310 3 | line-width 2 4 | group1: [ 5 | line1: push [ 6 | pen green 7 | line 30x310 100x110 8 | ] 9 | circle1: push [ 10 | pen green circle 30x310 3 11 | ] 12 | circle2: push [ 13 | pen green circle 100x110 3 14 | ] 15 | circle3: push [ 16 | fill-pen papaya 17 | pen papaya 18 | circle 30x310 3 19 | ] 20 | ] 21 | curve1: push [ 22 | pen papaya 23 | line-width 3 24 | curve 30x310 30x310 30x310 25 | ] 26 | line-width 1 27 | ] animations { 28 | tick: tick % 100 29 | curve1/2/7: circle1/2/4: line1/2/4: tick / 100.0 * (polygon1/3 - polygon1/2) + polygon1/2 30 | circle2/2/4: line1/2/5: tick / 100.0 * (polygon1/4 - polygon1/3) + polygon1/3 31 | curve1/2/8: circle3/2/6: tick / 100.0 * (line1/2/5 - line1/2/4) + line1/2/4 32 | } 33 | --------------------------------------------------------------------------------