├── Animated Truchet.red ├── Animation - Thinking Machines.gif ├── Ant_32.png ├── Axe-Truchet.red ├── Axe-truchet-flowers.png ├── Extended-Truchet-tiles.red ├── Hamilton_cycles.png ├── L-Systems.png ├── L-systems.red ├── Langton's ant.png ├── Langton's ant.red ├── Leaf Truchet.red ├── Leaf-Truchet.png ├── Optical Illusion Clock.red ├── Optical_Illusion_Clock.png ├── README.md ├── Slime mold simulation.red ├── Slime-random-XY.png ├── Slime_mold_simlation.png ├── Tesselations.red ├── Thinkig Machines Panel.red ├── TruTiles-CLI.red ├── TruTiles.png ├── TruTiles.red ├── Truchet.jpg └── stickman.red /Animated Truchet.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Animated Truchet tiles" 3 | Author: "Galen Ivanov" 4 | Date: 21-02-2020 5 | Needs: view 6 | ] 7 | random/seed now 8 | 9 | board: make block! 64 10 | bg: [64x64 164.200.255] 11 | big-img: make image! [512x512 255.255.255] 12 | frame: 0 13 | phase: 0.0 14 | step: 90 / 4.0 15 | 16 | collect/into [ 17 | repeat n 64 [ keep random 2 ] 18 | ] board 19 | 20 | repeat i 2 [ 21 | set [add1 add2] pick [[0x0 64x64] [64x0 0x64]] i 22 | phase: 0 23 | repeat n 10 [ 24 | img: to word! rejoin ['img i n - 1] 25 | set img make image! bg 26 | draw-block: copy [] 27 | angle: phase 28 | collect/into[ 29 | until [ 30 | ang: either i = 2 [angle][90 - angle] 31 | x1: 25 * cosine ang 32 | y1: -25 * sine ang 33 | x2: 39 * cosine ang 34 | y2: -39 * sine ang 35 | 36 | keep [line-width 5 pen gray line-cap round] 37 | keep compose [line (add1 + as-pair x1 y1) (add1 + as-pair x2 y2)] 38 | keep compose [line (add2 + as-pair x1 y1) (add2 + as-pair x2 y2)] 39 | 40 | keep [ line-width 5 pen white line-cap round] 41 | keep compose [line (add1 - 3 + as-pair x1 y1) (add1 - 3 + as-pair x2 y2)] 42 | keep compose [line (add2 - 3 + as-pair x1 y1) (add2 - 3 + as-pair x2 y2)] 43 | 44 | (step / 9.0 + 360) < angle: angle + step 45 | ] 46 | ] draw-block 47 | draw get img draw-block 48 | phase: step / 9.0 + phase 49 | ] 50 | ] 51 | 52 | update-board: does [ 53 | frame: frame + 1 % 9 54 | draw big-img collect [ 55 | repeat y 8 [ 56 | repeat x 8 [ 57 | fr: either odd? x + y [frame][9 - frame ] 58 | keep compose [ 59 | image 60 | (to word! rejoin['img board/(y - 1 * 8 + x) fr]) 61 | (as-pair x - 1 * 64 y - 1 * 64)] 62 | ] 63 | ] 64 | ] 65 | ] 66 | 67 | update-board 68 | 69 | view [ canvas: base 512x512 draw [ image big-img ] rate 30 70 | on-time [update-board append clear canvas/draw [image big-img]] 71 | ] 72 | -------------------------------------------------------------------------------- /Animation - Thinking Machines.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GalenIvanov/Graphics-Red/7d94de28142b2724962a7fa306c82295866fa874/Animation - Thinking Machines.gif -------------------------------------------------------------------------------- /Ant_32.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GalenIvanov/Graphics-Red/7d94de28142b2724962a7fa306c82295866fa874/Ant_32.png -------------------------------------------------------------------------------- /Axe-Truchet.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Axe - Truchet" 3 | Author: "Galen Ivanov" 4 | Date: 31-03-2025 5 | ] 6 | 7 | S: 128 8 | 9 | shape1: draw 1x1 * S compose [ 10 | pen transparent 11 | line-width 0 12 | fill-pen water 13 | circle (1x1 * S / 2) (S / 2) 14 | fill-pen white 15 | circle 0x0 (S / 2) 16 | circle (1x1 * S) (S / 2) 17 | ] 18 | 19 | shape2: draw 1x1 * S compose [ 20 | pen transparent 21 | line-width 0 22 | fill-pen water 23 | circle (1x1 * S / 2) (S / 2) 24 | fill-pen white 25 | circle (1x0 * S) (S / 2) 26 | circle (0x1 * S) (S / 2) 27 | ] 28 | 29 | tiles: collect [ 30 | repeat y 1024 / S [ 31 | repeat x 1024 / S [ 32 | ;keep reduce ['image shape1 as-pair x - 1 * S y - 1 * s] ; simple 33 | ;keep reduce ['image to-word pick [shape1 shape2] x % 2 + 1 as-pair x - 1 * S y - 1 * s] ; horizontal waves 34 | ;keep reduce ['image to-word pick [shape1 shape2] x + y % 2 + 1 as-pair x - 1 * S y - 1 * s] ; diagonal 35 | keep reduce ['image to-word pick [shape1 shape2] ((to 1 x / 2 % 2) + (to 1 y / 2 % 2)) % 2 + 1 as-pair x - 1 * S y - 1 * s] ; flowers 36 | ] 37 | ] 38 | ] 39 | 40 | save/as %Axe-truchet.png draw 1024x1024 tiles 'png 41 | 42 | view [base 1024x1024 draw compose [(tiles)]] -------------------------------------------------------------------------------- /Axe-truchet-flowers.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GalenIvanov/Graphics-Red/7d94de28142b2724962a7fa306c82295866fa874/Axe-truchet-flowers.png -------------------------------------------------------------------------------- /Extended-Truchet-tiles.red: -------------------------------------------------------------------------------- 1 | Red[ 2 | Title: "Extended Filled Truchet tiles" 3 | Author: "Galen Ivanov" 4 | Date: 20-02-2020 5 | Needs: view 6 | ] 7 | random/seed now 8 | 9 | img11: make image! bg: [32x32 255.255.255] 10 | img12: make image! bg 11 | img31: make image! bg 12 | img21: make image! bg: [32x32 164.200.255] 13 | img22: make image! bg 14 | img32: make image! bg 15 | 16 | big-img: make image! [512x512 255.255.255] 17 | 18 | t: [line-width 3 pen navy fill-pen] 19 | draw img11 compose [(t) sky circle 0x0 16 circle 32x32 16] 20 | draw img12 compose [(t) sky circle 32x0 16 circle 0x32 16] 21 | draw img31 compose [(t) sky box -2x-2 16x16 box 16x16 33x33] 22 | draw img21 compose [(t) white circle 32x0 16 circle 0x32 16] 23 | draw img22 compose [(t) white circle 0x0 16 circle 32x32 16] 24 | draw img32 compose [(t) white box -2x-2 16x16 box 16x16 33x33] 25 | 26 | draw big-img collect [ 27 | repeat y 16 [ 28 | repeat x 16 [ 29 | keep compose [ 30 | image 31 | (to word! rejoin['img random 3 x + y % 2 + 1]) 32 | (as-pair x - 1 * 32 y - 1 * 32)] 33 | ] 34 | ] 35 | ] 36 | save/as %truchet.jpg big-img 'jpeg 37 | 38 | view [ base 512x512 draw [ image big-img ] ] -------------------------------------------------------------------------------- /Hamilton_cycles.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GalenIvanov/Graphics-Red/7d94de28142b2724962a7fa306c82295866fa874/Hamilton_cycles.png -------------------------------------------------------------------------------- /L-Systems.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GalenIvanov/Graphics-Red/7d94de28142b2724962a7fa306c82295866fa874/L-Systems.png -------------------------------------------------------------------------------- /L-systems.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "L-systems" 3 | Author: "Galen Ivanov" 4 | Needs: 'View 5 | ] 6 | 7 | expand-axiom: function [ 8 | axiom [ string! ] 9 | iterations [ integer! ] 10 | rules [ block! ] 11 | ] [ 12 | loop iterations [ 13 | tmp: make string! 100000 14 | forall axiom [ 15 | either axiom/1 = #"(" [ axiom: find axiom ")" ] [ 16 | append tmp switch/default form axiom/1 rules [ axiom/1 ] 17 | ] 18 | ] 19 | axiom: tmp 20 | ] 21 | ] 22 | 23 | normalize-coords: function [ 24 | raw-coords [ block! ] 25 | width [ integer! ] 26 | ] [ 27 | set [ minx maxx miny maxy ] take/last raw-coords 28 | 29 | dx: maxx - minx 30 | dy: maxy - miny 31 | coef: ( 0.9 * width) / ( max dx dy ) 32 | offsx: width - ( dx * coef ) / 2 33 | offsy: width - ( dy * coef ) / 2 34 | 35 | collect/into [ 36 | keep [ pen gray box 0x0 799x799 pen black ] 37 | foreach item raw-coords [ 38 | t: type? item 39 | if t = block! [ keep as-pair item/1 - minx * coef + offsx 40 | item/2 - miny * coef + offsy ] 41 | if t = word! [ keep item ] 42 | ] 43 | ] make block! 100000 44 | ] 45 | 46 | parse-expanded: function [ 47 | expr [ string! ] 48 | used [ string! ] 49 | phi [ number! ] 50 | angle [ number! ] 51 | ] [ 52 | x: y: minx: maxx: miny: maxy: 0 53 | coord-stack: make block! 100000 54 | u: charset used 55 | 56 | collect/into [ 57 | parse expr [ 58 | any [ 59 | [ "(" copy c to ")" skip ] ( keep 'pen keep to word! c ) 60 | | u ( keep 'line 61 | keep/only reduce [ x y ] 62 | x: x + cosine angle 63 | y: y - sine angle 64 | keep/only reduce [ x y ] 65 | minx: min x minx 66 | maxx: max x maxx 67 | miny: min y miny 68 | maxy: max y maxy ) 69 | | "+" ( angle: angle + phi ) 70 | | "-" ( angle: angle - phi ) 71 | | "[" ( append/only coord-stack reduce [ x y angle ] ) 72 | | "]" ( set [ x y angle ] take/last coord-stack ) 73 | | skip 74 | ] 75 | ] 76 | keep/only reduce [ minx maxx miny maxy ] 77 | ] make block! 100000 78 | ] 79 | 80 | load-params: does [ 81 | rules: collect [ 82 | repeat idx 5 [ 83 | name: do rejoin ["c" idx "/text" ] 84 | rule: do rejoin ["r" idx "/text" ] 85 | if name <> none [ keep name keep/only to-block mold rule ] 86 | ] 87 | ] 88 | f: expand-axiom axiom-field/text to integer! iter-field/text rules 89 | p: parse-expanded f use-field/text to float! angle-field/text to float! rotate-field/text 90 | normalize-coords p 800 91 | ] 92 | 93 | samples: [ 94 | ; angle orientation iterations axiom use rules 95 | [ "60" "0" "5" "YF" "F" [ "X" [ "(teal)YF+XF+Y" ] "Y" [ "(cyan)XF-YF-X" ] ] ] ; Sierpinski arrowhead 96 | [ "60" "0" "4" "F+F+F+F" "F" [ "F" [ "(pink)F+F-F+F+F" ] ] ] ; Koch 97 | [ "90" "0" "2" "XYXYXYX+XYXYXYX+XYXYXYX+XYXYXYX" "XY" [ "X" [ "(orange)X+X+XY-Y-" ] ; joined cross curves 98 | "Y" [ "+X+XY-Y-Y" ] ] ] 99 | [ "90" "0" "12" "FL" "F" [ "L" [ "L+RF+" ] "R" [ "-FL-R" ] ] ] ; dragon curve 100 | [ "25" "90" "4" "F" "F" [ "F" [ "(brown)FF+[(green)+F-F-F]-[(leaf)-F+F+F]" ] ] ] ; plant 101 | [ "60" "30" "10" "X" "F" [ "X" [ "[-F+F[Y]+F][+F-F[X]-F]" ] ; hexagonal grif 102 | "Y" [ "[-F+F[Y]+F][+F-F-F]" ] ] ] 103 | [ "90" "0" "4" "X" "F" [ "X" [ "(water)-YF+XFX+FY-" ] "Y" [ "(water)+XF-YFY-FX+" ] ] ] ; Hilbert curve 104 | [ "60" "0" "3" "XF" "F" [ "X" [ "(olive)X+YF++YF-FX--FXFX-YF+" ] ; Hexagonal Gosper curve 105 | "Y" [ "-FX+YFYF++YF+FX--FX-Y" ] ] ] 106 | [ "90" "0" "3" "F+XF+F+XF" "F" [ "X" [ "(teal)XF-F+F-XF+F+XF-F+F-X" ] ] ] ; square-grid approximation of Sierpinsky curev 107 | [ "30" "0" "6" "W" "F" [ "W" [ "(red)+++X--F--ZFX+" ] ; lace 108 | "X" [ "(red)---W++F++YFW-" ] 109 | "Y" [ "+ZFX--F--Z+++" ] 110 | "Z" [ "-YFW++F++Y---" ] ] ] 111 | [ "15" "0" "4" "AAAA" "F" [ "A" [ "X+X+X+X+X+X+" ] ; concentric rings 112 | "X" [ "[(water)F+F+F+F[---X-Y]+++++F++++++++F-F-F-F]" ] 113 | "Y" [ "[F+F+F+F[---Y]+++++F++++++++F-F-F-F]"] ] ] 114 | [ "36" "0" "3" "[7]++[7]++[7]++[7]++[7]" "1" [ "6" [ " 81++91----71[-81----61]++" ] ; Penrose tiling 115 | "7" [ "+81--91[---61--71]+" ] 116 | "8" [ "-(tanned)61++71[+++81++91]-" ] 117 | "9" [ "--81++++61[+91++++71]--71" ] 118 | "1" [ "" ] ] ] 119 | ] 120 | 121 | load-sample: func [ n ] [ 122 | sample: copy samples/:n 123 | 124 | angle-field/text: copy sample/1 125 | rotate-field/text: copy sample/2 126 | iter-field/text: form 1 + do copy sample/3 127 | axiom-field/text: copy sample/4 128 | use-field/text: copy sample/5 129 | 130 | sp: " " 131 | repeat idx 5 [ 132 | do rejoin ["c" idx "/text: sp"] 133 | do rejoin ["r" idx "/text: sp"] 134 | ] 135 | 136 | idx: 1 137 | foreach [name rule] sample/6 [ 138 | do rejoin ["c" idx "/text: name"] 139 | do rejoin ["r" idx "/text: form rule"] 140 | idx: idx + 1 141 | ] 142 | clear canvas/draw 143 | append canvas/draw load-params 144 | ] 145 | 146 | draw-samples: does [ 147 | idx: 1 148 | foreach sample samples [ 149 | f: expand-axiom sample/4 to integer! sample/3 sample/6 150 | p: parse-expanded f sample/5 to float! sample/1 to float! sample/2 151 | do rejoin ["append canvas" idx "/draw normalize-coords p 110"] 152 | idx: idx + 1 153 | ] 154 | ] 155 | 156 | frame: [ pen gray box 0x0 109x109 pen black ] 157 | 158 | view [ 159 | title "L-systems / Red :: Galen Ivanov" 160 | on-create [ draw-samples ] 161 | 162 | across 163 | text 35 "Angle" angle-field: field 50 "60" 164 | text 60 "Orientation" rotate-field: field 50 "0" 165 | text 50 "Iterations" iter-field: field 50 "3" return 166 | 167 | text 35 "Axiom" axiom-field: field 200 "F--F--F" 168 | text 30 "Use" use-field: field 50 "F" return 169 | 170 | text 35 "Rule 1" c1: field 20 "F" r1: field 270 "F+F--F+F" return 171 | text 35 "Rule 2" c2: field 20 r2: field 270 return 172 | text 35 "Rule 3" c3: field 20 r3: field 270 return 173 | text 35 "Rule 4" c4: field 20 r4: field 270 return 174 | text 35 "Rule 5" c5: field 20 r5: field 270 return 175 | 176 | start: button 345x40 font-size 16 "Start" [ append clear canvas/draw load-params ] return 177 | text font-size 16 "Examples" return 178 | 179 | style thumb: base white 110x110 180 | canvas1: thumb draw copy frame [ load-sample 1 ] 181 | canvas2: thumb draw copy frame [ load-sample 2 ] 182 | canvas3: thumb draw copy frame [ load-sample 3 ] return 183 | canvas4: thumb draw copy frame [ load-sample 4 ] 184 | canvas5: thumb draw copy frame [ load-sample 5 ] 185 | canvas6: thumb draw copy frame [ load-sample 6 ] return 186 | canvas7: thumb draw copy frame [ load-sample 7 ] 187 | canvas8: thumb draw copy frame [ load-sample 8 ] 188 | canvas9: thumb draw copy frame [ load-sample 9 ] return 189 | canvas10: thumb draw copy frame [ load-sample 10 ] 190 | canvas11: thumb draw copy frame [ load-sample 11 ] 191 | canvas12: thumb draw copy frame [ load-sample 12 ] return 192 | below return 193 | 194 | canvas: base white 800x800 195 | draw [ pen gray box 0x0 799x799 pen black ] 196 | ] 197 | -------------------------------------------------------------------------------- /Langton's ant.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GalenIvanov/Graphics-Red/7d94de28142b2724962a7fa306c82295866fa874/Langton's ant.png -------------------------------------------------------------------------------- /Langton's ant.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Langton's ant" 3 | Author: "Galen Ivanov" 4 | Date: 04-02-2021 5 | Needs: 'view 6 | ] 7 | 8 | img-ant: load %Ant_32.png 9 | cell-size: 32 10 | n-cells: 20 11 | color1: beige 12 | color2: aqua 13 | pos: 1x1 * ( n-cells / 2 + 1 ) + 1 14 | rot: 180 15 | speed: 5 16 | steps: 0 17 | run: true 18 | instr: "Turn the mouse wheel over the yellow square to change the animation speed" 19 | 20 | make-id: function [ pair ][ to set-word! rejoin [ "c" pair ] ] 21 | 22 | board: collect [ 23 | keep [ pen white ] 24 | repeat y n-cells [ 25 | repeat x n-cells [ 26 | keep compose [ 27 | ( make-id as-pair x y ) 28 | fill-pen ( color1 ) 29 | box ( as-pair x - 1 * cell-size y - 1 * cell-size ) 30 | ( as-pair x * cell-size y * cell-size ) 31 | ] 32 | ] 33 | ] 34 | keep compose [ 35 | ant: translate ( pos * cell-size ) 36 | rotate 180 16x16 [ image img-ant ] 37 | ] 38 | ] 39 | 40 | update-ant: does [ 41 | steps: steps + 1 42 | steps-txt/text: rejoin [ "Steps: " steps ] 43 | id-series: find board make-id pos 44 | col: pick id-series 3 45 | 46 | set [ col sign ] reduce pick [ [ color2 1 ] [ color1 -1 ] ] col = color1 47 | pos: ( pick [ 0x1 -1x0 0x-1 1x0 ] rot / 90 + 1 ) * sign + pos 48 | rot: modulo sign * 90 + rot 360 49 | 50 | if any [ 51 | pos/x < 1 52 | pos/y < 1 53 | pos/x > n-cells 54 | pos/y > n-cells 55 | ][ 56 | status/text: "The ant left the area. You can press Reset" 57 | run: false 58 | ] 59 | 60 | change at id-series 3 col 61 | ant: get to set-word! "ant" 62 | change at ant 2 pos - 1 * cell-size 63 | change at ant 4 rot 64 | ] 65 | 66 | reset: does [ 67 | pos: 1x1 * ( n-cells / 2 + 1 ) + 1 68 | rot: 180 69 | speed: 5 70 | steps: 0 71 | parse board [ any [ thru quote 'fill-pen change skip ( beige ) ] to end ] 72 | grid/draw: board 73 | status/text: instr 74 | grid/rate: speed 75 | spd/text: to "" speed 76 | run: true 77 | ] 78 | 79 | view compose/deep [ 80 | title "Langton's ant" 81 | 82 | below 83 | 84 | grid: base (1x1 * cell-size * n-cells) #9FAFFF 85 | draw board 86 | rate (speed) on-time [ if run [ update-ant ] ] 87 | 88 | status: text 500x16 ( instr ) 89 | 90 | return 91 | below 92 | 93 | spd: base 64x64 yello ( to "" speed ) 94 | on-wheel [ 95 | speed: min 30 max 1 speed + to 1 event/picked 96 | spd/text: form speed 97 | grid/rate: speed 98 | ] 99 | 100 | steps-txt: text "0" 101 | reset-btn: button "Reset" [ reset ] 102 | ] 103 | -------------------------------------------------------------------------------- /Leaf Truchet.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | title: "Leaf-shaped Truchet tiles" 3 | author: "Galen Ivanov" 4 | date: 14-07-2021 5 | needs: view 6 | ] 7 | 8 | W: 800 9 | H: 600 10 | d: 50 11 | 12 | random/seed now 13 | 14 | tile1: make image! compose [(as-pair d d) (sky)] 15 | tile2: copy tile1 16 | 17 | draw tile1 compose/deep[ 18 | fill-pen white pen sky 19 | shape [arc (as-pair d d) (d) (d) 90 arc 0x0 (d) (d) 90] 20 | ] 21 | 22 | draw tile2 compose/deep[ 23 | fill-pen white pen sky 24 | shape [move (as-pair d 0) arc (as-pair 0 d) (d) (d) 90 arc (as-pair d 0) (d) (d) 90] 25 | ] 26 | 27 | truchet: collect [ 28 | repeat y H / d [ 29 | repeat x W / d [ 30 | t: rejoin ['tile random 2] 31 | keep compose [image (to-word t) (as-pair x - 1 * d y - 1 * d)] 32 | ] 33 | ] 34 | ] 35 | 36 | view compose [title "Leaf Truchet" base (as-pair W H) sky draw truchet] -------------------------------------------------------------------------------- /Leaf-Truchet.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GalenIvanov/Graphics-Red/7d94de28142b2724962a7fa306c82295866fa874/Leaf-Truchet.png -------------------------------------------------------------------------------- /Optical Illusion Clock.red: -------------------------------------------------------------------------------- 1 | Red[ 2 | Title: "Optical Illusion Clock" 3 | Author: "Galen Ivanov" 4 | Date: 24-02-2020 5 | Needs: 'View 6 | ] 7 | 8 | digits: [ 9 | [ ;0 10 | [0 0 0 0] 11 | [0 1 1 1] 12 | [0 1 0 1] 13 | [0 1 0 1] 14 | [0 1 0 1] 15 | [0 1 0 1] 16 | [0 1 0 1] 17 | [0 1 1 1] 18 | [0 0 0 0] 19 | ][ ;1 20 | [0 0 0 0] 21 | [0 0 0 1] 22 | [0 0 1 1] 23 | [0 0 0 1] 24 | [0 0 0 1] 25 | [0 0 0 1] 26 | [0 0 0 1] 27 | [0 0 0 1] 28 | [0 0 0 0] 29 | ][ ;2 30 | [0 0 0 0] 31 | [0 1 1 1] 32 | [0 0 0 1] 33 | [0 0 0 1] 34 | [0 1 1 1] 35 | [0 1 0 0] 36 | [0 1 0 0] 37 | [0 1 1 1] 38 | [0 0 0 0] 39 | ][ ;3 40 | [0 0 0 0] 41 | [0 1 1 1] 42 | [0 1 0 1] 43 | [0 0 0 1] 44 | [0 1 1 1] 45 | [0 0 0 1] 46 | [0 0 0 1] 47 | [0 1 1 1] 48 | [0 0 0 0] 49 | ][ ;4 50 | [0 0 0 0] 51 | [0 1 0 1] 52 | [0 1 0 1] 53 | [0 1 0 1] 54 | [0 1 1 1] 55 | [0 0 0 1] 56 | [0 0 0 1] 57 | [0 0 0 1] 58 | [0 0 0 0] 59 | ][ ;5 60 | [0 0 0 0] 61 | [0 1 1 1] 62 | [0 1 0 0] 63 | [0 1 0 0] 64 | [0 1 1 1] 65 | [0 0 0 1] 66 | [0 0 0 1] 67 | [0 1 1 1] 68 | [0 0 0 0] 69 | ][ ;6 70 | [0 0 0 0] 71 | [0 1 1 1] 72 | [0 1 0 0] 73 | [0 1 0 0] 74 | [0 1 1 1] 75 | [0 1 0 1] 76 | [0 1 0 1] 77 | [0 1 1 1] 78 | [0 0 0 0] 79 | ][ ;7 80 | [0 0 0 0] 81 | [0 1 1 1] 82 | [0 0 0 1] 83 | [0 0 0 1] 84 | [0 0 0 1] 85 | [0 0 0 1] 86 | [0 0 0 1] 87 | [0 0 0 1] 88 | [0 0 0 0] 89 | ][ ;8 90 | [0 0 0 0] 91 | [0 1 1 1] 92 | [0 1 0 1] 93 | [0 1 0 1] 94 | [0 1 1 1] 95 | [0 1 0 1] 96 | [0 1 0 1] 97 | [0 1 1 1] 98 | [0 0 0 0] 99 | ][ ;9 100 | [0 0 0 0] 101 | [0 1 1 1] 102 | [0 1 0 1] 103 | [0 1 0 1] 104 | [0 1 1 1] 105 | [0 0 0 1] 106 | [0 0 0 1] 107 | [0 1 1 1] 108 | [0 0 0 0] 109 | ] 110 | ] 111 | 112 | offs: [0x0 80x0 200x0 280x0] 113 | draw-blk: make block! 200 114 | img1: make image! [20x20 255.255.240] 115 | draw img1 [line-width 2 line-cap round pen papaya line 0x5 5x0 116 | line 0x15 15x0 line 5x20 20x5 line 15x20 20x15] 117 | img2: make image! [20x20 255.255.240] 118 | draw img2 [line-width 2 line-cap round pen papaya line 15x0 20x5 119 | line 5x0 20x15 line 0x5 15x20 line 0x15 5x20] 120 | 121 | sep1: make image! [20x180 255.255.240] 122 | draw sep1 collect [ 123 | repeat n 9[ 124 | keep reduce ['image 'img1 as-pair 0 n - 1 * 20] 125 | ] 126 | ] 127 | 128 | sep2: make image! [20x180 255.255.240] 129 | draw sep2 collect [ 130 | repeat n 9[ 131 | keep reduce ['image 'img1 as-pair 0 n - 1 * 20] 132 | ] 133 | keep [image img2 0x60 image img2 0x100] 134 | ] 135 | 136 | repeat n 10 [ 137 | img: to word! rejoin ['digit n - 1] 138 | set img make image! [80x180 255.255.255] 139 | draw get img collect [ 140 | repeat r 9 [ 141 | repeat c 4 [ 142 | keep 'image 143 | keep to word! rejoin ['img either zero? digits/:n/:r/:c[1][2]] 144 | keep as-pair c - 1 * 20 r - 1 * 20 145 | ] 146 | ] 147 | ] 148 | ] 149 | 150 | collect/into [ 151 | repeat n 4 [ 152 | keep reduce ['image to word! rejoin ['digit n] offs/:n] 153 | ] 154 | ] draw-blk 155 | 156 | update-time: has[ 157 | t c p i sec 158 | ][ 159 | t: now/time 160 | i: 0 161 | collect/into [ 162 | foreach c rejoin [pad/left/with t/1 2 #"0" pad/left/with t/2 2 #"0"][ 163 | p: -48 + to integer! c 164 | i: i + 1 165 | 166 | keep reduce ['image to word! rejoin ['digit p ] offs/:i] 167 | ] 168 | sep: either zero? t/3 % 2 ['sep1]['sep2] 169 | keep reduce['image 'sep1 160x0 'image sep 180x0 'image 'sep1 360x0] 170 | 171 | ] clear draw-blk 172 | append clear canvas/draw draw-blk 173 | ] 174 | 175 | view [ 176 | title "Optical Illusion Clock" 177 | canvas: base 380x180 draw [] 178 | rate 5 on-time [update-time] 179 | ] 180 | -------------------------------------------------------------------------------- /Optical_Illusion_Clock.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GalenIvanov/Graphics-Red/7d94de28142b2724962a7fa306c82295866fa874/Optical_Illusion_Clock.png -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Graphics-Red 2 | Graphics/visualization with Red 3 | 4 | L-systems 5 | - 6 | 7 | 8 | L-systems.red is a tool for exploring the world of L-systems, inspired by http://www.kevs3d.co.uk/dev/lsystems/# 9 | 10 | Most examples are taken from "Lindenmayer Systems, Fractals, and Plants", available at http://algorithmicbotany.org/papers/lsfp.pdf 11 | 12 | Extended Filled Truchet tiles 13 | - 14 | Simple tiling of the plane with 2 sets of Truchet tiles, each set consisting of 3 tiles. 15 | 16 | 17 | Optical illusion clock 18 | - 19 | A software cover of a [TokyoFlash watch](https://tokyoflash.com/collections/watches/products/optical-illusion-lcd-watch) 20 | 21 | 22 | 23 | Langton's ant 24 | - 25 | A little project demonstrating the [Langton's ant](https://en.wikipedia.org/wiki/Langton%27s_ant) (a two-dimensional universal Turing machine) 26 | 27 | 28 | 29 | 30 | Slime mold simulation 31 | - 32 | Inspired by the work of Sebastian Lague 33 | 34 | 35 | 36 | 37 | Leaf-shaped Truchet tiles 38 | - 39 | A simple variation of simple Truchet tiles, where the diagonal lines are replaced by "leaves" 40 | 41 | 42 | 43 | TruTiles 44 | - 45 | Pattern generator. It creates a grid of tiles (the 3 regular and another 6 semiregular tesselations of the plane) and renders each tile with a mix of 5 styles: 46 | - Tile: the outline of the tile 47 | - Dual: lines from the centers of the edges to the center of the tile 48 | - Diamond: lines connecting the centers of the edges 49 | - Truchet: arcs connecting the edges two by two 50 | - Diagonals: lines connecting the vertices of the tile and the center of the tile 51 | 52 | 53 | 54 | Thinking Machines Panel 55 | - 56 | Inspired by by the front panels of [Connection Machine](https://en.wikipedia.org/wiki/Connection_Machine) and Thinking Machnes Corporation supercomputers. 57 | 58 | 59 | 60 | 61 | Axe Truchet 62 | - 63 | Another simple Truchet-like tiling, based on a single tile shaped like a double axe. 64 | 65 | 66 | -------------------------------------------------------------------------------- /Slime mold simulation.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Slime mold simulation, inspired by the work of Sebastian Lague" 3 | Author: "Galen Ivanov" 4 | Note: "Needs compilation!" 5 | needs: view 6 | ] 7 | 8 | random/seed now 9 | W: 800 10 | H: 600 11 | N: 1000 12 | delta: 32 13 | slime: make block! N * 4 14 | 15 | tbuf: #{} 16 | loop W * H * 3 [append tbuf 0] 17 | bin: copy #{} 18 | loop W * H * 3 [append bin 0] 19 | 20 | init-slime: func [n] [ 21 | collect [ 22 | repeat i n [ 23 | keep reduce [ 24 | random W ; pos X 25 | random H ; pos Y 26 | ;W / 2 ; pos X - cebter 27 | ;H / 2 ; pos Y - center 28 | random 360 ; angle 29 | 3 + random 3 ; speed 30 | 200.80.20 + random 55.25.20 ; color 31 | ] 32 | ] 33 | ] 34 | ] 35 | 36 | #system[ 37 | rsblur: func[ 38 | buf [red-binary!] 39 | w [integer!] 40 | h [integer!] 41 | tbuf [red-binary!] 42 | /local s src d dst offs offs- offs+ idx w3 x y 43 | ][ 44 | s: GET_BUFFER(buf) 45 | src: (as byte-ptr! s/offset) 46 | d: GET_BUFFER(tbuf) 47 | dst: (as byte-ptr! d/offset) 48 | w3: w * 3 49 | loop h [ 50 | idx: 1 51 | loop w3[ 52 | offs-: idx - 3 // w3 53 | offs+: idx + 3 // w3 54 | dst/1: as byte!((as integer! src/idx)+(as integer! src/offs-)+(as integer! src/offs+) / 3) 55 | idx: idx + 1 56 | dst: dst + 1 57 | ] 58 | src: src + w3 59 | ] 60 | src: (as byte-ptr! s/offset) 61 | dst: (as byte-ptr! d/offset) 62 | y: 0 63 | offs: 1 64 | loop h [ 65 | x: 1 66 | loop w3[ 67 | offs-: y - 1 // h * w3 + x 68 | offs+: y + 1 // h * w3 + x 69 | src/1: as byte!((as integer! dst/offs)+(as integer! dst/offs-)+(as integer! dst/offs+) / 3) 70 | x: x + 1 71 | offs: offs + 1 72 | src: src + 1 73 | ] 74 | y: y + 1 75 | ] 76 | ] 77 | ] 78 | 79 | blur: routine[ 80 | buf [binary!] 81 | width [integer!] 82 | height [integer!] 83 | tbuf [binary!] 84 | ][ 85 | rsblur buf width height tbuf 86 | ] 87 | 88 | update-slime: has[ 89 | pix offs lines xl xc xr yl yc yr cl cc cr 90 | ][ 91 | offs: 1 92 | lines: collect [ 93 | keep [line-width 1] 94 | foreach [x y a s c] slime [ 95 | keep compose[pen (c)] 96 | 97 | keep 'line 98 | keep as-pair to 1 x to 1 y 99 | 100 | a: a + 2 - random 3 101 | 102 | xc: x + (s * cosine a) 103 | yc: y - (s * sine a) 104 | cc: img/(as-pair xc yc) 105 | 106 | xl: x + (s * (cosine (a - delta))) 107 | yl: y - (s * (sine (a - delta))) 108 | cl: img/(as-pair xl yl) 109 | 110 | xr: x + (s * (cosine (a + delta))) 111 | yr: y - (s * (sine (a + delta))) 112 | cr: img/(as-pair xr yr) 113 | 114 | set [x y a] copy/part sort/reverse/skip/compare reduce [ 115 | xc yc a cc 116 | xl yl a - delta cl 117 | xr yr a + delta cr 118 | ] 4 4 3 119 | 120 | slime/(offs + 2): a 121 | 122 | case [ ; reflect 123 | x < 1 [x: 1 slime/(offs + 2): 540 - a] 124 | x > W [x: W slime/(offs + 2): 180 - a] 125 | y < 1 [y: 1 slime/(offs + 2): 360 - a] 126 | y > H [y: H slime/(offs + 2): 360 - a] 127 | ] 128 | keep as-pair to 1 x to 1 y 129 | slime/:offs: x 130 | slime/(offs + 1): y 131 | offs: offs + 5 132 | ] 133 | ] 134 | 135 | draw img lines 136 | bin: img/rgb 137 | blur bin img/size/x img/size/y tbuf 138 | img/rgb: bin 139 | append clear canvas/draw [image img] 140 | ] 141 | 142 | img: make image! compose[(as-pair W H) 0.0.0] 143 | slime: init-slime N 144 | 145 | 146 | view compose/deep [ 147 | title "Slime simulation" 148 | canvas: base (as-pair W H) 149 | draw [image (img)] rate 30 150 | on-time [update-slime] 151 | ] 152 | -------------------------------------------------------------------------------- /Slime-random-XY.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GalenIvanov/Graphics-Red/7d94de28142b2724962a7fa306c82295866fa874/Slime-random-XY.png -------------------------------------------------------------------------------- /Slime_mold_simlation.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GalenIvanov/Graphics-Red/7d94de28142b2724962a7fa306c82295866fa874/Slime_mold_simlation.png -------------------------------------------------------------------------------- /Tesselations.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Plane tesselations" 3 | Author: "Galen Ivanov" 4 | Needs: 'View 5 | ] 6 | 7 | { 8 | The Grid is a set of Cells 9 | The set is generated using Rules 10 | } 11 | { 12 | Rules: 13 | [ 14 | Square: ; type 15 | [ 16 | 90 Square ; turning angle; the type of the neighbor sharing the same edge 17 | 90 Square 18 | 90 Square 19 | 90 Square 20 | ] 21 | ] 22 | } 23 | 24 | { 25 | Cell [ 26 | id: s1 ; the average of the coords of all edges? - a pair a x b 27 | type: square ; [ triangle square rhombus hexagon octagon ... ] 28 | color: 29 | data: 30 | edges: [ 31 | edge1 id-neighbor1 or BORDER 32 | edge2 id-neighbor2 or BORDER 33 | ... 34 | edge-n id-neighbor-n or BORDER 35 | ] 36 | ] 37 | } 38 | 39 | cells: make block! 1000 40 | cell-size: 0 41 | 42 | ;rules: [square: [90 square 90 square 90 square 90 square]] 43 | ;rules: [hex: [120 hex 120 hex 120 hex 120 hex 120 hex 120 hex]] 44 | ;rules: [tri: [60 tri 60 tri 60 tri]] 45 | ;rules: [hex: [120 tri 120 tri 120 tri 120 tri 120 tri 120 tri] 46 | ; tri: [60 hex 60 hex 60 hex]] 47 | ;rules: [octa: [135 octa 135 square 135 octa 135 square 135 octa 135 square 135 octa 135 square] 48 | ; square: [90 octa 90 octa 90 octa 90 octa] ] 49 | ;rules: [square: [90 tri 90 tri 90 tri 90 tri] 50 | ; tri: [60 tri 60 square 60 square]] 51 | 52 | ;rules: [hex: [120 square 120 square 120 square 120 square 120 square 120 square] 53 | ; square: [90 tri 90 hex 90 tri 90 hex] 54 | ; tri: [60 square 60 square 60 square]] 55 | 56 | ;rules: [p12: [150 p3 150 p12 150 p3 150 p12 150 p3 150 p12 150 p3 150 p12 150 p3 150 p12 150 p3 150 p12] 57 | ; p3: [60 p12 60 p12 60 p12]] 58 | 59 | rules: [hex: [120 tri1 120 tri1 120 tri1 120 tri1 120 tri1 120 tri1] 60 | tri1: [60 hex 60 tri2 60 tri1] 61 | tri2: [60 tri1 60 tri1 60 tri1]] 62 | 63 | ;rules: [dodeca: [150 hex 150 square 150 hex 150 square 150 hex 150 square 150 hex 150 square 150 hex 150 square 150 hex 150 square ] 64 | ; hex: [120 dodeca 120 square 120 dodeca 120 square 120 dodeca 120 square] 65 | ; square: [90 dodeca 90 hex 90 dodeca 90 hex]] 66 | 67 | ;rules: [sq1: [90 t1 90 t2 90 t3 90 t4] 68 | ; sq2: [90 t4 90 t1 90 t2 90 t3] 69 | ; t1: [60 sq1 60 sq2 60 t3] 70 | ; t2: [60 sq1 60 sq2 60 t4] 71 | ; t3: [60 sq1 60 sq2 60 t1] 72 | ; t4: [60 sq1 60 sq2 60 t2]] 73 | 74 | 75 | ;rules: [sq1: [90 td1 90 sq2 90 tu1 90 sq2] 76 | ; sq2: [90 td2 90 sq1 90 tu2 90 sq1] 77 | ; td1: [60 sq1 60 tu1 60 tu2] 78 | ; tu1: [60 sq1 60 td1 60 td2] 79 | ; td2: [60 sq2 60 tu2 60 tu1] 80 | ; tu2: [60 sq2 60 td2 60 td1] 81 | ;] 82 | 83 | 84 | 85 | 86 | ;conds: [x > 40 x < 460 y > 40 y < 460] 87 | conds: [x > 40 x < 560 y > 40 y < 560] 88 | ;conds: [200 > sqrt (x - 250 * (x - 250) + (y - 250 * ( y - 250)))] 89 | ;conds: [ x + y > 250 x + y < 650 x - y > -150 x - y < 250 ] 90 | cells-to-check: make block! 1000 91 | 92 | num: 0 93 | 94 | grid: [ 95 | pen yello 96 | ;box 0x0 500x500 97 | line-width 2 98 | fill-pen beige 99 | ;box 40x40 460x460 100 | ;circle 250x250 200 101 | fill-pen pink 102 | pen black 103 | polygon 104 | ] 105 | 106 | calc-center: function [ 107 | coords [block!] {a block with coordinates [x1 y1 x2 y2 ... xn yn]} 108 | factor [integer!] {scale factor} 109 | ][ 110 | x: to integer! average extract coords 2 111 | y: to integer! average extract next coords 2 112 | as-pair round/to x factor round/to y factor 113 | ] 114 | 115 | pair-cell-coords: function [ 116 | cell [block!] 117 | ][ 118 | grid: copy [] 119 | foreach [x y] cell [ 120 | append grid as-pair to-integer x to-integer y 121 | ] 122 | grid 123 | ] 124 | 125 | calc-cell-points: func[ 126 | size [integer!] 127 | x [number!] 128 | y [number!] 129 | angle [number!] 130 | cell-type [string!] 131 | /local 132 | cell poly rot ang 133 | 134 | ][ 135 | cell: make block! 20 136 | poly: extract select rules to set-word! cell-type 2 137 | ang: angle 138 | foreach rot poly [ 139 | append cell reduce[x y] 140 | x: (size * cosine ang) + x 141 | y: y - (size * sine ang) 142 | ang: ang + 180 - rot ; need to round it to the starting angle + possible steps! 143 | ] 144 | cell 145 | ] 146 | 147 | get-new-cell-edges: func [ 148 | cell [block!] 149 | cell-type [string!] 150 | rules-offs [integer!] 151 | /local 152 | n cell2 cell-rules 153 | ][ 154 | cell2: copy cell 155 | move/part cell2 tail cell2 2 156 | 157 | cell-rules: select rules to-set-word cell-type ; needs anchor ! 158 | move/part cell-rules tail cell-rules rules-offs - 2 159 | 160 | collect/into [ 161 | repeat n to 1 (length? cell) / 2[ 162 | keep/only collect [ 163 | keep reduce [ 164 | cell/(n * 2 - 1) 165 | cell/(n * 2) 166 | cell2/(n * 2 - 1) 167 | cell2/(n * 2) 168 | to-string cell-rules/(n * 2) "_" 169 | ] 170 | ] 171 | ] 172 | keep cell-type 173 | ] make block! 4 * length? cell 174 | ] 175 | 176 | within-area?: function [ 177 | cell-center [pair!] 178 | conds [block!] 179 | ][ 180 | cell-xy: make object! [ 181 | x: cell-center/x 182 | y: cell-center/y 183 | ] 184 | bind conds cell-xy ; isn't it slow to bind it each time? 185 | either all conds [ yes ] [ no ] 186 | ] 187 | 188 | n-to-go: func[c-id][ 189 | c-cell: copy select cells c-id 190 | remove-each e c-cell [e/6 <> "_"] 191 | length? c-cell 192 | ] 193 | 194 | same-edge?: function [ 195 | e1 [block!] 196 | e2 [block!] 197 | ][ 198 | either all [ 199 | 1 > absolute e2/1 - e1/1 200 | 1 > absolute e2/2 - e1/2 201 | 1 > absolute e2/3 - e1/3 202 | 1 > absolute e2/4 - e1/4 203 | ][on][off] 204 | ] 205 | 206 | make-id: function[coord][to-set-word rejoin ["C" coord]] 207 | 208 | make-cells: has [ 209 | cell-id 210 | cell 211 | cell-type 212 | edge 213 | n 214 | ang 215 | new-cell-id 216 | new-cell 217 | new-cell-edges 218 | new-center 219 | common-edge 220 | caller 221 | offs 222 | existing? 223 | ][ 224 | 225 | ;if not empty? cells-to-check [ 226 | ; if num > 260 [return 1] 227 | ; num: num + 1 228 | cell-id: pick cells-to-check random length? cells-to-check 229 | cell: select cells cell-id 230 | caller: last cell 231 | 232 | edge: cell 233 | n: length? edge 234 | while [all[n > 0 edge/1/6 <> "_"]][ 235 | edge: next edge 236 | n: n - 1 237 | ] 238 | either zero? n [ ; selected cell has all edges processed 239 | remove find cells-to-check cell-id 240 | 241 | ][ 242 | edge: edge/1 243 | ang: 180 - arctangent2 edge/4 - edge/2 edge/3 - edge/1 244 | 245 | new-cell: calc-cell-points cell-size edge/3 edge/4 ang edge/5 246 | new-center: calc-center new-cell 2;cell-size 247 | 248 | either within-area? new-center conds [ 249 | new-cell-id: make-id new-center 250 | edge/6: new-cell-id 251 | if zero? n-to-go cell-id [remove find cells-to-check cell-id] 252 | existing?: false 253 | 254 | either find cells new-cell-id [ 255 | existing?: true 256 | ][ 257 | append cells-to-check new-cell-id 258 | append cells new-cell-id 259 | 260 | cell-type: edge/5 261 | 262 | offs: index? find rules/(to set-word! cell-type) to set-word! caller 263 | append/only cells get-new-cell-edges new-cell cell-type offs 264 | 265 | ] 266 | 267 | new-cell-edges: select cells new-cell-id 268 | common-edge: reduce[edge/3 edge/4 edge/1 edge/2] 269 | while [not same-edge? copy/part new-cell-edges/1 4 common-edge][ 270 | new-cell-edges: next new-cell-edges 271 | ] 272 | new-cell-edges/1/6: cell-id 273 | 274 | either existing? [ 275 | if zero? n-to-go new-cell-id [remove find cells-to-check new-cell-id] 276 | ][ 277 | append grid 'fill-pen 278 | ;append grid beige 279 | ;append grid pick [pink leaf] #"s" = cell-type/1 280 | ;append grid pick [pink olive sky] index? find ["hex" "dodeca" "square"] cell-type 281 | append grid pick [pink olive sky] index? find ["hex" "tri1" "tri2"] cell-type 282 | append grid 'polygon 283 | append grid pair-cell-coords copy new-cell 284 | 285 | ] 286 | 287 | 288 | ][ 289 | edge/6: "Border" 290 | if zero? n-to-go cell-id [remove find cells-to-check cell-id] 291 | ] 292 | ] 293 | ;] 294 | ] 295 | 296 | init-cells: func [ 297 | new-rules [block!] 298 | new-conds [block!] 299 | size [integer!] 300 | posX [number!] 301 | posY [number!] 302 | rot [integer!] 303 | cell-type [string!] 304 | /local cell cell-center n edges cell-name cell2 305 | ][ 306 | random/seed now 307 | clear head cells 308 | rules: new-rules 309 | conds: new-conds 310 | cell-size: size 311 | 312 | cell: calc-cell-points size posX posY rot cell-type 313 | cell-center: calc-center cell 2; cell-size 314 | 315 | if within-area? cell-center conds [ 316 | cell-name: make-id cell-center 317 | append cells cell-name 318 | append grid pair-cell-coords copy cell 319 | 320 | append/only cells get-new-cell-edges cell cell-type 0 321 | 322 | ;append/only cells get-new-cell-edges cell 0 323 | append cells-to-check cell-name 324 | ] 325 | ] 326 | 327 | 328 | ;init-cells rules conds 40 200 200 15 "square" 329 | init-cells rules conds 44 250 250 15 "hex" 330 | ;init-cells rules conds 20 250 250 30 "tri" 331 | ;init-cells rules conds 20 250 250 30 "p12" 332 | ;init-cells rules conds 20 200 200 30 "octa" 333 | ;init-cells rules conds 30 200 200 45 "sq1" 334 | ;init-cells rules conds 30 200 200 45 "sq1" 335 | 336 | 337 | while [not empty? cells-to-check][make-cells] 338 | ;loop 10[make-cells] 339 | 340 | ;print calc-center [6.0 60.0 100.0 60.0 100.0 20.0 60.0 20.0] cell-size / 2 341 | 342 | view [ 343 | title "Tilings" 344 | base 600x600 teal 345 | draw grid 346 | 347 | ] 348 | 349 | ;view[base 500x500 draw sq-grid] 350 | -------------------------------------------------------------------------------- /Thinkig Machines Panel.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Thinking Machines Panel simulation" 3 | Author: "Galen Ivanov" 4 | ] 5 | 6 | random/seed now 7 | 8 | light-rows: collect [ 9 | loop 32 [ 10 | keep/only collect [loop 32 [keep pick [red black] (random 9) < 4]] 11 | ] 12 | ] 13 | 14 | move-lights: does [ 15 | ; rows in groups of 4 slide alternatingly to the left or to the right 16 | forall light-rows [ 17 | size: (to-integer (index? light-rows) - 1 / 4) // 2 * 30 + 1 18 | move/part light-rows/1 tail light-rows/1 size 19 | ] 20 | 21 | pos: at led-panel 4 22 | repeat y 32 [ 23 | repeat x 16 [ 24 | pos/1: light-rows/:y/:x 25 | pos: skip pos 5 26 | ] 27 | ] 28 | ] 29 | 30 | led-panel: collect [ 31 | keep [pen transparent] 32 | repeat y 32 [ 33 | repeat x 16 [ 34 | keep 'fill-pen 35 | keep light-rows/:y/:x ; these will be updated 36 | keep 'box 37 | keep make point2D! compose [(x - 1 * 16) (y - 1 * 16)] 38 | keep make point2D! compose [(x * 16) (y * 16)] 39 | ] 40 | ] 41 | ] 42 | 43 | view [ 44 | title "Connection Machines Display" 45 | base (256, 512) draw led-panel rate 8 46 | on-time [move-lights] 47 | ] 48 | -------------------------------------------------------------------------------- /TruTiles-CLI.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Pattern generator - CLI version" 3 | Author: "Galen Ivanov" 4 | CLI: "by @hiimboris" 5 | Needs: 'View 6 | ] 7 | 8 | ; CLI dialect for Red 9 | ; https://gitlab.com/hiiamboris/red-cli 10 | #include %cli.red 11 | 12 | cells: make block! 2000 13 | cell-size: 40 14 | 15 | ; tesselation rules 16 | r3: [tri: [60 tri 60 tri 60 tri]] 17 | r4: [square: [90 square 90 square 90 square 90 square]] 18 | r6: [hex: [120 hex 120 hex 120 hex 120 hex 120 hex 120 hex]] 19 | r6-3: [hex: [120 tri 120 tri 120 tri 120 tri 120 tri 120 tri] 20 | tri: [60 hex 60 hex 60 hex]] 21 | r6-3-3: [hex: [120 tri1 120 tri1 120 tri1 120 tri1 120 tri1 120 tri1] 22 | tri1: [60 hex 60 tri2 60 tri1] 23 | tri2: [60 tri1 60 tri1 60 tri1]] 24 | r6-4-3: [hex: [120 square 120 square 120 square 120 square 120 square 120 square] 25 | square: [90 tri 90 hex 90 tri 90 hex] 26 | tri: [60 square 60 square 60 square]] 27 | r8-4: [octa: [135 octa 135 square 135 octa 135 square 135 octa 135 square 135 octa 135 square] 28 | square: [90 octa 90 octa 90 octa 90 octa]] 29 | r12-3: [p12: [150 tri 150 p12 150 tri 150 p12 150 tri 150 p12 150 tri 150 p12 150 tri 150 p12 150 tri 150 p12] 30 | tri: [60 p12 60 p12 60 p12]] 31 | r12-6-4: [p12: [150 hex 150 sq 150 hex 150 sq 150 hex 150 sq 150 hex 150 sq 150 hex 150 sq 150 hex 150 sq] 32 | hex: [120 p12 120 sq 120 p12 120 sq 120 p12 120 sq] 33 | sq: [90 p12 90 hex 90 p12 90 hex]] 34 | r4-3: [sq1: [90 t1 90 t2 90 t3 90 t4] 35 | sq2: [90 t4 90 t1 90 t2 90 t3] 36 | t1: [60 sq1 60 sq2 60 t3] 37 | t2: [60 sq1 60 sq2 60 t4] 38 | t3: [60 sq1 60 sq2 60 t1] 39 | t4: [60 sq1 60 sq2 60 t2]] 40 | r4-3a: [sq1: [90 td1 90 sq2 90 tu1 90 sq2] 41 | sq2: [90 td2 90 sq1 90 tu2 90 sq1] 42 | td1: [60 sq1 60 tu1 60 tu2] 43 | tu1: [60 sq1 60 td1 60 td2] 44 | td2: [60 sq2 60 tu2 60 tu1] 45 | tu2: [60 sq2 60 td2 60 td1]] 46 | 47 | 48 | all-rules: [r3 25 r4 20 r6 15 r6-3 15 r6-3-3 15 r6-4-3 12 r8-4 12 r12-3 10 r12-6-4 10 r4-3 15 r4-3a 15] 49 | rules: make block! 100 50 | conds-thumbs: [x > 0 x < 100 y > 0 y < 100] 51 | conds-screen: [x > 0 x < 800 y > 0 y < 645] 52 | conds-big: [x > 0 x < 1920 y > 0 y < 1080] 53 | cells-to-check: make block! 10000 54 | grid: make block! 10000 55 | coords: make block! 10000 56 | 57 | ;initial settings 58 | cur-rule: 'r6-3-3 ;'r4 59 | prop: copy [100 0 0 0 0] 60 | cell-sz: 40 61 | rot: 0 62 | cell-width: 3 63 | line-color: sky 64 | bgcolor: aqua 65 | shadow?: off 66 | shadowcolor: white 67 | shadow-sz: 9 68 | shad-offs: 0x0 69 | ;r-tile: 100 70 | ;r-dual: r-diam: r-truchet: r-diag: 0 71 | rnd-seed: 0 72 | out-file: %TruTiles.png 73 | bg: on 74 | 75 | prog-c: [r3 7.8 r4 4 r6 2.2 r6-3 3.5 r6-3-3 3.5 r6-4-3 4 r8-4 1.9 r12-3 1.5 r12-6-4 2.0 r4-3 5.8 r4-3a 5.8] 76 | 77 | ;r3: 78 | ;r4: 79 | ;r6: 80 | ;r6-3: 81 | ;r6-3-3: 82 | ;r6-4-3: 83 | ;r8-4: 84 | ;r12-3: 85 | ;r12-6-4: 86 | ;r4-3: 87 | ;r4-3a: 88 | 89 | grid-header: [ 90 | line-cap round 91 | line-join round 92 | pen aqua 93 | thick: line-width 5 94 | fill-pen aqua 95 | box 0x0 1920x1080 96 | fill-pen 0.0.0.255 97 | color: pen white 98 | ] 99 | 100 | grid-front: [ 101 | thick: line-width 3 102 | fill-pen transparent 103 | color: pen snow 104 | ] 105 | 106 | frame: [line-width 5 pen yellow box 0x0 100x100] 107 | 108 | calc-center: function [ 109 | coords [block!] {a block with coordinates [x1 y1 x2 y2 ... xn yn]} 110 | factor [integer!] {scale factor} 111 | ][ 112 | x: to integer! average extract coords 2 113 | y: to integer! average extract next coords 2 114 | as-pair round/to x factor round/to y factor 115 | ] 116 | 117 | render-cell: function [ 118 | cell [block!] 119 | freq [block!] 120 | ][ 121 | grd: copy [scale 0.1 0.1] 122 | grid: copy [] 123 | 124 | len: (length? cell) / 2 125 | stretch: len - 2 * 180 / len + 1 126 | 127 | set [orig dual diam truchet diag] freq 128 | 129 | dual: orig + dual 130 | diam: dual + diam 131 | truchet: truchet + diam 132 | diag: truchet + diag 133 | 134 | skp: random 3 135 | move/part cell tail cell 2 * skp 136 | 137 | sel: random 99 138 | cx: to-integer average extract cell 2 139 | cy: to-integer average extract next cell 2 140 | 141 | offs: 10x10 * either bg [shad-offs][0x0] 142 | 143 | case [ 144 | sel <= orig [ 145 | append grid 'polygon 146 | foreach [x y] cell [ 147 | append grid offs + as-pair to-integer x to-integer y 148 | ] 149 | ] 150 | sel <= dual [ 151 | i: 1 152 | loop (len: length? cell) / 2 [ 153 | x: to-integer cell/:i + cell/(i + 1 % len + 1) / 2 154 | y: to-integer cell/(i + 1) + cell/(i + 2 % len + 1) / 2 155 | append grid reduce ['line offs + as-pair x y offs + as-pair cx cy] 156 | i: i + 2 157 | ] 158 | ] 159 | sel <= diam [ 160 | i: 1 161 | loop (len: length? cell) / 2 [ 162 | x1: to-integer cell/:i + cell/(i + 1 % len + 1) / 2 163 | y1: to-integer cell/(i + 1) + cell/(i + 2 % len + 1) / 2 164 | x2: to-integer cell/(i + 1 % len + 1) + cell/(i + 3 % len + 1) / 2 165 | y2: to-integer cell/(i + 2 % len + 1) + cell/(i + 4 % len + 1) / 2 166 | append grid reduce ['line offs + as-pair x1 y1 offs + as-pair x2 y2] 167 | i: i + 2 168 | ] 169 | ] 170 | 171 | sel <= truchet [ 172 | foreach [x1 y1 x2 y2] cell [ 173 | x2: any [x2 cell/1] 174 | y2: any [y2 cell/2] 175 | cntr: offs + as-pair to-integer x2 to-integer y2 176 | bgn: 179 + modulo to integer!(arctangent2 y2 - y1 x2 - x1) 360 177 | append grid reduce ['arc cntr 10x10 * cell-size / 2 bgn stretch] 178 | ] 179 | ] 180 | sel > truchet [ 181 | foreach [x y] cell [ 182 | append grid reduce ['line offs + as-pair x y offs + as-pair cx cy] 183 | ] 184 | ] 185 | ] 186 | move/part at tail cell -2 * skp cell 2 * skp 187 | append/only grd grid 188 | grd 189 | ] 190 | 191 | calc-cell-points: func[ 192 | size [integer!] 193 | x [number!] 194 | y [number!] 195 | angle [number!] 196 | cell-type [string!] 197 | /local 198 | cell poly rot ang 199 | 200 | ][ 201 | cell: make block! 20 202 | poly: extract select rules to set-word! cell-type 2 203 | ang: angle 204 | foreach rot poly [ 205 | append cell reduce[x y] 206 | x: (size * cosine ang) + x 207 | y: y - (size * sine ang) 208 | ang: ang + 180 - rot 209 | ] 210 | cell 211 | ] 212 | 213 | get-new-cell-edges: func [ 214 | cell [block!] 215 | cell-type [string!] 216 | rules-offs [integer!] 217 | /local 218 | n cell2 cell-rules 219 | ][ 220 | cell2: copy cell 221 | move/part cell2 tail cell2 2 222 | 223 | cell-rules: select rules to-set-word cell-type 224 | move/part cell-rules tail cell-rules rules-offs - 2 225 | 226 | collect/into [ 227 | repeat n to 1 (length? cell) / 2[ 228 | keep/only collect [ 229 | keep reduce [ 230 | cell/(n * 2 - 1) 231 | cell/(n * 2) 232 | cell2/(n * 2 - 1) 233 | cell2/(n * 2) 234 | to-string cell-rules/(n * 2) "_" 235 | ] 236 | ] 237 | ] 238 | keep cell-type 239 | ] make block! 4 * length? cell 240 | ] 241 | 242 | check-boundaries: none ; will be a function 243 | 244 | n-to-go: func[c-id][ 245 | c-cell: copy select cells c-id 246 | remove-each e c-cell [e/6 <> "_"] 247 | length? c-cell 248 | ] 249 | 250 | same-edge?: function [ 251 | e1 [block!] 252 | e2 [block!] 253 | ][ 254 | res: true 255 | repeat n 4 [ 256 | res: res and (1 > absolute e2/:n - e1/:n ) 257 | ] 258 | ] 259 | 260 | make-id: function[coord][to-set-word rejoin ["C" coord]] 261 | 262 | make-cells: has [ 263 | cell cell-id cell-type edge n ang 264 | new-cell-id new-cell new-cell-edges new-center 265 | common-edge caller offs existing? 266 | ][ 267 | cell-id: pick cells-to-check random length? cells-to-check 268 | cell: select cells cell-id 269 | caller: last cell 270 | 271 | edge: cell 272 | n: length? edge 273 | while [all[n > 0 edge/1/6 <> "_"]][ 274 | edge: next edge 275 | n: n - 1 276 | ] 277 | either zero? n [ ; selected cell has all edges processed 278 | remove find cells-to-check cell-id 279 | ][ 280 | edge: edge/1 281 | ang: 180 - arctangent2 edge/4 - edge/2 edge/3 - edge/1 282 | new-cell: calc-cell-points 10 * cell-size edge/3 edge/4 ang edge/5 283 | new-center: calc-center new-cell 2 284 | cell-type: edge/5 285 | 286 | either check-boundaries new-center [ 287 | new-cell-id: make-id new-center 288 | edge/6: new-cell-id 289 | if zero? n-to-go cell-id [remove find cells-to-check cell-id] 290 | existing?: false 291 | 292 | either find cells new-cell-id [ 293 | existing?: true 294 | ][ 295 | append cells-to-check new-cell-id 296 | append cells new-cell-id 297 | offs: index? find rules/(to set-word! cell-type) to set-word! caller 298 | append/only cells get-new-cell-edges new-cell cell-type offs 299 | ] 300 | 301 | new-cell-edges: select cells new-cell-id 302 | common-edge: reduce[edge/3 edge/4 edge/1 edge/2] 303 | while [not same-edge? copy/part new-cell-edges/1 4 common-edge][ 304 | new-cell-edges: next new-cell-edges 305 | ] 306 | new-cell-edges/1/6: cell-id 307 | 308 | if existing? [if zero? n-to-go new-cell-id [remove find cells-to-check new-cell-id]] 309 | ][ 310 | edge/6: "Border" 311 | if zero? n-to-go cell-id [remove find cells-to-check cell-id] 312 | ] 313 | ] 314 | ] 315 | 316 | draw-cells: has [ 317 | cell edge 318 | ][ 319 | collect [ 320 | foreach [_ cell] head cells [ 321 | keep/only collect [ 322 | foreach edge copy/part cell back tail cell [keep edge/1 keep edge/2] 323 | ] 324 | ] 325 | ] 326 | ] 327 | 328 | init-cells: func [ 329 | new-rules [block!] 330 | new-conds [block!] 331 | size [integer!] 332 | posX [number!] 333 | posY [number!] 334 | rot [integer!] 335 | /local cell cell-center n edges cell-name cell-type cond-out 336 | ][ 337 | random/seed rnd-seed 338 | clear head cells 339 | rules: copy new-rules 340 | conds: copy new-conds 341 | 342 | cond-out: to integer! size * (length? rules/2) / 4 * 10 343 | 344 | conds/3: 0 - cond-out 345 | conds/6: conds/6 * 10 + cond-out 346 | conds/9: 0 - cond-out 347 | conds/12: conds/12 * 10 + cond-out 348 | 349 | ; make a function to check either the cell is in the boundaries set by cond 350 | check-boundaries: func [p] [x: p/x y: p/y to-logic all conds] 351 | 352 | cell-size: size 353 | cell-type: to-string new-rules/1 354 | 355 | cell: calc-cell-points 10 * size posX posY rot cell-type 356 | cell-center: calc-center cell 2 357 | 358 | if check-boundaries cell-center [ 359 | cell-name: make-id cell-center 360 | append cells cell-name 361 | append/only cells get-new-cell-edges cell cell-type 0 362 | append cells-to-check cell-name 363 | ] 364 | ] 365 | 366 | render-grid: func [ 367 | img? [logic!] ; render to screen or file? 368 | /local sp count n t1 t2 cond 369 | ][ 370 | t1: now/time/precise 371 | 372 | count: 2000 / cell-sz * (1000 / cell-sz) 373 | n: 0 374 | 375 | count: count * (select prog-c cur-rule) ; ; progress etimate - imprecise! 376 | progress: to-integer count / 20 377 | unless shadow? [count: to-integer count * 0.66] 378 | 379 | ; normalize the mix of the effects 380 | prop: reduce [prop/1 prop/2 prop/3 prop/4 prop/5] 381 | either zero? sp: sum prop [ 382 | prop: [20 20 20 20 20] 383 | norm: 1 384 | ][ 385 | norm: 100.0 / sp 386 | ] 387 | forall prop [prop/1: to-integer norm * prop/1] 388 | 389 | big-img: make image! [1920x1080 0.0.0.255] 390 | 391 | cond: either img? [conds-big][conds-screen] 392 | 393 | init-cells get cur-rule cond cell-sz 5000 5000 rot 394 | while [not empty? cells-to-check][ 395 | make-cells 396 | n: n + 1 397 | if zero? n % progress [prin dot n: 0] 398 | ] 399 | 400 | random/seed rnd-seed 401 | coords: draw-cells 402 | clear grid 403 | append clear grid compose [fill-pen (bgcolor) box 0x0 1920x1080 line-cap round line-join round] 404 | bg: on 405 | if shadow? [ 406 | append grid compose [line-width (10 * shadow-sz) pen (shadowcolor)] 407 | foreach c coords [ 408 | append grid render-cell c prop 409 | n: n + 1 410 | if zero? n % progress [prin dot n: 0] 411 | ] 412 | ] 413 | bg: off 414 | change at find grid-front 'color 3 line-color 415 | change at find grid-front 'thick 3 10 * cell-width 416 | append grid grid-front 417 | ;--------- 418 | append grid [scale-factor: scale 1 1] 419 | ; 420 | random/seed rnd-seed 421 | foreach c coords [ 422 | append grid render-cell c prop 423 | n: n + 1 424 | if zero? n % progress [prin dot n: 0] 425 | ] 426 | t2: now/time/precise 427 | ;print ["Image generated for" t2 - t1 "seconds"] 428 | draw big-img grid 429 | ] 430 | 431 | [ 432 | cur-rule: 'r6-3-3 ;'r4 433 | cell-sz: 40 434 | rot: 0 435 | cell-width: 3 436 | line-color: 42.120.150 437 | bgcolor: aqua 438 | shadow?: on 439 | shadowcolor: black 440 | shadow-sz: 9 441 | shad-offs: 0x0 442 | r-tile: 100 443 | r-dual: r-diam: r-truchet: r-diag: 0 444 | prop: copy [100 0 0 0 0] 445 | rnd-seed: 0 446 | out-file: %TruTiles.png 447 | ] 448 | 449 | fix-input: does [ 450 | unless find [r3 r4 r6 r6-3 r6-3-3 r6-4-3 r8-4 r12-3 r12-6-4 r4-3 r4-3a] cur-rule [ 451 | cur-rule: 'r4 452 | print "Unknown rule, Defaulting to r4 (square grid)" 453 | ] 454 | if any [cell-sz < 15 cell-sz > 250][ 455 | cell-sz: 40 456 | print "Size is outside the limits. Defaulting to 40 pixels" 457 | ] 458 | if any [cell-width < 1 cell-width > 200][ 459 | cell-width: 3 460 | print "Width is outside the limits. Defaulting to 3 pixels" 461 | ] 462 | if 4 < length? line-color [ 463 | line-color: sky 464 | print "Color is invalid. Defaulting to sky" 465 | ] 466 | if 4 < length? bgcolor [ 467 | bgcolor: aqua 468 | print "Background color is invalid. Defaulting to aqua" 469 | ] 470 | if 4 < length? shadowcolor [ 471 | shadowcolor: black 472 | print "Background color is invalid. Defaulting to black" 473 | ] 474 | if any [shadow-sz < 1 shadow-sz > 250][ 475 | shadow-sz: 9 476 | print "Shadow line width is outside the limits. Defaulting to 9 pixels" 477 | ] 478 | if 5 <> length? prop [ 479 | prop: 100.0.0.0.0 480 | print "Effect mix must be a 5-tuple. Defaulting to 100.0.0.0.0" 481 | ] 482 | unless parse out-file [to [".png" end]] [append out-file ".png"] 483 | 484 | ] 485 | 486 | program: func [ 487 | rule {Type of tiling to be used - one of r3, r4, r6, r6-3, r6-3-3, r6-4-3, r8-4, r12-3, r12-6-4, r4-3 or r4-3a} 488 | /size 489 | cell-size [integer!] {Size of the cell, between 15 and 250. Default: 40 pixels} 490 | /rotate 491 | rotation [number! float!] {Rotation angle. Default: 0 degrees} 492 | /width 493 | cell-line [integer!] {Line width. Default: 3 pixels} 494 | /color 495 | edge-clr {Cell edge color. Default: sky} 496 | /bg-color 497 | bg-clr {Backgraound color. Default: aqua} 498 | /shadow {Turn on shadow. Default: off} 499 | /sh-color 500 | shadow-clr {Shadow color. Default: black } 501 | /sh-line 502 | shadow-size [integer!] {Shadow line width. Default: 9 pixels} 503 | /sh-offset 504 | shadow-offs [pair!] {Shadow offset. Default: 0x0} 505 | /tile-mix 506 | ratio {Share of each effect in the image: Tile, Dual, Diamond, Truchet, Diagonal. Default: 100.0.0.0.0} 507 | /seed 508 | rand-seed [integer!] {Random seed. Default: 0} 509 | /o 510 | output [string!] {Output file name. Default: TruTiles.png } 511 | /v {Display result in a window} 512 | ][ 513 | cur-rule: to-lit-word rule 514 | cell-sz: any [cell-size cell-sz] 515 | rot: any [rotation rot] 516 | cell-width: any [cell-line cell-width] 517 | if color [line-color: load edge-clr] 518 | if bg-color [bgcolor: load bg-clr] 519 | if shadow [shadow?: on] 520 | if sh-color [shadowcolor: load shadow-clr] 521 | if sh-line [shadow-sz: shadow-size] 522 | if sh-offset [shad-offs: shadow-offs] 523 | if tile-mix [prop: load ratio] 524 | rnd-seed: any [rand-seed rnd-seed] 525 | if o [out-file: to-file output] 526 | 527 | fix-input 528 | 529 | prin "Working " 530 | render-grid true 531 | save/as out-file big-img 'png 532 | if v [? (big-img)] 533 | ] 534 | 535 | cli/process-into program 536 | -------------------------------------------------------------------------------- /TruTiles.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GalenIvanov/Graphics-Red/7d94de28142b2724962a7fa306c82295866fa874/TruTiles.png -------------------------------------------------------------------------------- /TruTiles.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Pattern generator based on plane tesselations and Truchet tiles" 3 | Author: "Galen Ivanov" 4 | Needs: 'View 5 | ] 6 | 7 | cells: make block! 2000 8 | cell-size: 0 9 | 10 | ; tesselation rules 11 | r3: [tri: [60 tri 60 tri 60 tri]] 12 | r4: [square: [90 square 90 square 90 square 90 square]] 13 | r6: [hex: [120 hex 120 hex 120 hex 120 hex 120 hex 120 hex]] 14 | r6-3: [hex: [120 tri 120 tri 120 tri 120 tri 120 tri 120 tri] 15 | tri: [60 hex 60 hex 60 hex]] 16 | r6-3-3: [hex: [120 tri1 120 tri1 120 tri1 120 tri1 120 tri1 120 tri1] 17 | tri1: [60 hex 60 tri2 60 tri1] 18 | tri2: [60 tri1 60 tri1 60 tri1]] 19 | r6-4-3: [hex: [120 square 120 square 120 square 120 square 120 square 120 square] 20 | square: [90 tri 90 hex 90 tri 90 hex] 21 | tri: [60 square 60 square 60 square]] 22 | r8-4: [octa: [135 octa 135 square 135 octa 135 square 135 octa 135 square 135 octa 135 square] 23 | square: [90 octa 90 octa 90 octa 90 octa]] 24 | r12-3: [p12: [150 tri 150 p12 150 tri 150 p12 150 tri 150 p12 150 tri 150 p12 150 tri 150 p12 150 tri 150 p12] 25 | tri: [60 p12 60 p12 60 p12]] 26 | r12-6-4: [p12: [150 hex 150 sq 150 hex 150 sq 150 hex 150 sq 150 hex 150 sq 150 hex 150 sq 150 hex 150 sq] 27 | hex: [120 p12 120 sq 120 p12 120 sq 120 p12 120 sq] 28 | sq: [90 p12 90 hex 90 p12 90 hex]] 29 | r4-3: [sq1: [90 t1 90 t2 90 t3 90 t4] 30 | sq2: [90 t4 90 t1 90 t2 90 t3] 31 | t1: [60 sq1 60 sq2 60 t3] 32 | t2: [60 sq1 60 sq2 60 t4] 33 | t3: [60 sq1 60 sq2 60 t1] 34 | t4: [60 sq1 60 sq2 60 t2]] 35 | r4-3a: [sq1: [90 td1 90 sq2 90 tu1 90 sq2] 36 | sq2: [90 td2 90 sq1 90 tu2 90 sq1] 37 | td1: [60 sq1 60 tu1 60 tu2] 38 | tu1: [60 sq1 60 td1 60 td2] 39 | td2: [60 sq2 60 tu2 60 tu1] 40 | tu2: [60 sq2 60 td2 60 td1]] 41 | 42 | ;all-rules: [r3 20 r4 15 r6 10 r6-3 10 r6-3-3 10 r6-4-3 8 r8-4 8 r12-3 7 r12-6-4 7 r4-3 12 r4-3a 12] 43 | all-rules: [r3 25 r4 20 r6 15 r6-3 15 r6-3-3 15 r6-4-3 12 r8-4 12 r12-3 10 r12-6-4 10 r4-3 15 r4-3a 15] 44 | rules: make block! 100 45 | ;conds: make block! 100 46 | conds-thumbs: [x > 0 x < 100 y > 0 y < 100] 47 | conds-screen: [x > 0 x < 800 y > 0 y < 645] 48 | conds-big: [x > 0 x < 1920 y > 0 y < 1080] 49 | cells-to-check: make block! 10000 50 | grid: make block! 10000 51 | coords: make block! 10000 52 | 53 | ;initial settings 54 | cur-rule: 'r3 55 | prop: copy [100 0 0 0 0] 56 | cell-sz: 40 57 | rotation: 0 58 | cell-width: 3 59 | line-color: white 60 | bgcolor: aqua 61 | shadow?: off 62 | shadowcolor: white 63 | shadowsz: 9 64 | shadowoffs: 0x0 65 | r-tile: 100 66 | r-dual: r-diam: r-truchet: r-diag: 0 67 | rndseed: 0 68 | bg: on 69 | prog-c: [r3 7.8 r4 4 r6 2.2 r6-3 3.5 r6-3-3 3.5 r6-4-3 4 r8-4 1.9 r12-3 1.5 r12-6-4 2.0 r4-3 5.8 r4-3a 5.8] 70 | 71 | 72 | grid-header: [ 73 | line-cap round 74 | line-join round 75 | pen aqua 76 | thick: line-width 5 77 | fill-pen aqua 78 | box 0x0 1920x1080 79 | fill-pen 0.0.0.255 80 | color: pen white 81 | ] 82 | 83 | grid-front: [ 84 | thick: line-width 3 85 | fill-pen transparent 86 | color: pen snow 87 | ] 88 | 89 | frame: [line-width 5 pen yellow box 0x0 100x100] 90 | 91 | calc-center: function [ 92 | coords [block!] {a block with coordinates [x1 y1 x2 y2 ... xn yn]} 93 | factor [integer!] {scale factor} 94 | ][ 95 | x: to integer! average extract coords 2 96 | y: to integer! average extract next coords 2 97 | as-pair round/to x factor round/to y factor 98 | ] 99 | 100 | render-cell: function [ 101 | cell [block!] 102 | freq [block!] 103 | ][ 104 | grd: copy [scale 0.1 0.1] 105 | grid: copy [] 106 | 107 | len: (length? cell) / 2 108 | stretch: len - 2 * 180 / len + 1 109 | 110 | set [orig dual diam truchet diag] freq 111 | 112 | dual: orig + dual 113 | diam: dual + diam 114 | truchet: truchet + diam 115 | diag: truchet + diag 116 | 117 | skp: random 3 118 | move/part cell tail cell 2 * skp 119 | 120 | sel: random 99 121 | cx: to-integer average extract cell 2 122 | cy: to-integer average extract next cell 2 123 | 124 | offs: either bg [shadowoffs][0x0] 125 | 126 | case [ 127 | sel <= orig [ 128 | append grid 'polygon 129 | foreach [x y] cell [ 130 | append grid offs + as-pair to-integer x to-integer y 131 | ] 132 | ] 133 | sel <= dual [ 134 | i: 1 135 | loop (len: length? cell) / 2 [ 136 | x: to-integer cell/:i + cell/(i + 1 % len + 1) / 2 137 | y: to-integer cell/(i + 1) + cell/(i + 2 % len + 1) / 2 138 | append grid reduce ['line offs + as-pair x y offs + as-pair cx cy] 139 | i: i + 2 140 | ] 141 | ] 142 | sel <= diam [ 143 | i: 1 144 | loop (len: length? cell) / 2 [ 145 | x1: to-integer cell/:i + cell/(i + 1 % len + 1) / 2 146 | y1: to-integer cell/(i + 1) + cell/(i + 2 % len + 1) / 2 147 | x2: to-integer cell/(i + 1 % len + 1) + cell/(i + 3 % len + 1) / 2 148 | y2: to-integer cell/(i + 2 % len + 1) + cell/(i + 4 % len + 1) / 2 149 | append grid reduce ['line offs + as-pair x1 y1 offs + as-pair x2 y2] 150 | i: i + 2 151 | ] 152 | ] 153 | 154 | sel <= truchet [ 155 | foreach [x1 y1 x2 y2] cell [ 156 | x2: any [x2 cell/1] 157 | y2: any [y2 cell/2] 158 | cntr: offs + as-pair to-integer x2 to-integer y2 159 | bgn: 179 + modulo to integer!(arctangent2 y2 - y1 x2 - x1) 360 160 | append grid reduce ['arc cntr 10x10 * cell-size / 2 bgn stretch] 161 | ] 162 | ] 163 | sel > truchet [ 164 | foreach [x y] cell [ 165 | append grid reduce ['line offs + as-pair x y offs + as-pair cx cy] 166 | ] 167 | ] 168 | ] 169 | move/part at tail cell -2 * skp cell 2 * skp 170 | append/only grd grid 171 | grd 172 | ] 173 | 174 | calc-cell-points: func[ 175 | size [integer!] 176 | x [number!] 177 | y [number!] 178 | angle [number!] 179 | cell-type [string!] 180 | /local 181 | cell poly rot ang 182 | 183 | ][ 184 | cell: make block! 20 185 | poly: extract select rules to set-word! cell-type 2 186 | ang: angle 187 | foreach rot poly [ 188 | append cell reduce[x y] 189 | x: (size * cosine ang) + x 190 | y: y - (size * sine ang) 191 | ang: ang + 180 - rot 192 | ] 193 | cell 194 | ] 195 | 196 | get-new-cell-edges: func [ 197 | cell [block!] 198 | cell-type [string!] 199 | rules-offs [integer!] 200 | /local 201 | n cell2 cell-rules 202 | ][ 203 | cell2: copy cell 204 | move/part cell2 tail cell2 2 205 | 206 | cell-rules: select rules to-set-word cell-type 207 | move/part cell-rules tail cell-rules rules-offs - 2 208 | 209 | collect/into [ 210 | repeat n to 1 (length? cell) / 2[ 211 | keep/only collect [ 212 | keep reduce [ 213 | cell/(n * 2 - 1) 214 | cell/(n * 2) 215 | cell2/(n * 2 - 1) 216 | cell2/(n * 2) 217 | to-string cell-rules/(n * 2) "_" 218 | ] 219 | ] 220 | ] 221 | keep cell-type 222 | ] make block! 4 * length? cell 223 | ] 224 | 225 | check-boundaries: none ; will be a function 226 | 227 | n-to-go: func[c-id][ 228 | c-cell: copy select cells c-id 229 | remove-each e c-cell [e/6 <> "_"] 230 | length? c-cell 231 | ] 232 | 233 | same-edge?: function [ 234 | e1 [block!] 235 | e2 [block!] 236 | ][ 237 | res: true 238 | repeat n 4 [ 239 | res: res and (1 > absolute e2/:n - e1/:n ) 240 | ] 241 | ] 242 | 243 | make-id: function[coord][to-set-word rejoin ["C" coord]] 244 | 245 | make-cells: has [ 246 | cell cell-id cell-type edge n ang 247 | new-cell-id new-cell new-cell-edges new-center 248 | common-edge caller offs existing? 249 | ][ 250 | cell-id: pick cells-to-check random length? cells-to-check 251 | cell: select cells cell-id 252 | caller: last cell 253 | 254 | edge: cell 255 | n: length? edge 256 | while [all[n > 0 edge/1/6 <> "_"]][ 257 | edge: next edge 258 | n: n - 1 259 | ] 260 | either zero? n [ ; selected cell has all edges processed 261 | remove find cells-to-check cell-id 262 | ][ 263 | edge: edge/1 264 | ang: 180 - arctangent2 edge/4 - edge/2 edge/3 - edge/1 265 | new-cell: calc-cell-points 10 * cell-size edge/3 edge/4 ang edge/5 266 | new-center: calc-center new-cell 2 267 | cell-type: edge/5 268 | 269 | either check-boundaries new-center [ 270 | new-cell-id: make-id new-center 271 | edge/6: new-cell-id 272 | if zero? n-to-go cell-id [remove find cells-to-check cell-id] 273 | existing?: false 274 | 275 | either find cells new-cell-id [ 276 | existing?: true 277 | ][ 278 | append cells-to-check new-cell-id 279 | append cells new-cell-id 280 | offs: index? find rules/(to set-word! cell-type) to set-word! caller 281 | append/only cells get-new-cell-edges new-cell cell-type offs 282 | ] 283 | 284 | new-cell-edges: select cells new-cell-id 285 | common-edge: reduce[edge/3 edge/4 edge/1 edge/2] 286 | while [not same-edge? copy/part new-cell-edges/1 4 common-edge][ 287 | new-cell-edges: next new-cell-edges 288 | ] 289 | new-cell-edges/1/6: cell-id 290 | 291 | if existing? [if zero? n-to-go new-cell-id [remove find cells-to-check new-cell-id]] 292 | ][ 293 | edge/6: "Border" 294 | if zero? n-to-go cell-id [remove find cells-to-check cell-id] 295 | ] 296 | ] 297 | ] 298 | 299 | draw-cells: has [ 300 | cell edge 301 | ][ 302 | collect [ 303 | foreach [_ cell] head cells [ 304 | keep/only collect [ 305 | foreach edge copy/part cell back tail cell [keep edge/1 keep edge/2] 306 | ] 307 | ] 308 | ] 309 | ] 310 | 311 | init-cells: func [ 312 | new-rules [block!] 313 | new-conds [block!] 314 | size [integer!] 315 | posX [number!] 316 | posY [number!] 317 | rot [integer!] 318 | /local cell cell-center n edges cell-name cell-type cond-out 319 | ][ 320 | random/seed rndseed 321 | clear head cells 322 | rules: copy new-rules 323 | conds: copy new-conds 324 | 325 | cond-out: to integer! size * (length? rules/2) / 4 * 10 326 | 327 | conds/3: 0 - cond-out 328 | conds/6: conds/6 * 10 + cond-out 329 | conds/9: 0 - cond-out 330 | conds/12: conds/12 * 10 + cond-out 331 | 332 | ; make a function to check either the cell is in the boundaries set by cond 333 | check-boundaries: func [p] [x: p/x y: p/y to-logic all conds] 334 | 335 | cell-size: size 336 | cell-type: to-string new-rules/1 337 | 338 | cell: calc-cell-points 10 * size posX posY rot cell-type 339 | cell-center: calc-center cell 2 340 | 341 | if check-boundaries cell-center [ 342 | cell-name: make-id cell-center 343 | append cells cell-name 344 | append/only cells get-new-cell-edges cell cell-type 0 345 | append cells-to-check cell-name 346 | ] 347 | ] 348 | 349 | make-thumbs: does [ 350 | foreach [rule size] all-rules [ 351 | init-cells get rule conds-thumbs size 40 40 0 352 | while [not empty? cells-to-check][make-cells] 353 | img: to-word rejoin [rule "-img"] 354 | set img make image! [100x100 0.0.0.255] 355 | grid: copy grid-header 356 | foreach c draw-cells [append grid render-cell c prop] 357 | draw get img grid 358 | ] 359 | ] 360 | 361 | select-thumb: func [ 362 | rule 363 | /local old-face face img 364 | ][ 365 | old-face: get to-word rejoin ["b-" cur-rule] 366 | img: to-word rejoin [cur-rule "-img"] 367 | append clear old-face/draw compose [image (img)] 368 | face: get to-word rejoin ["b-" rule] 369 | img: to-word rejoin [rule "-img"] 370 | append clear face/draw compose [image (img) (frame)] 371 | cur-rule: rule 372 | ] 373 | ;init-cells rules conds 50 150 150 0 "tri" 374 | 375 | render-grid: func [ 376 | img? [logic!] ; render to screen or file? 377 | /local sp count n t1 t2 cond 378 | ][ 379 | t1: now/time/precise 380 | rndseed: either empty? rs: f-rand/text [0][to-integer rs] 381 | 382 | count: 2000 / cell-sz * (1000 / cell-sz) 383 | n: 0 384 | prog/data: 0 385 | 386 | count: count * (select prog-c cur-rule) ; ; progress etimate !!! - I need to update them 387 | unless shadow? [count: to-integer count * 0.66] 388 | 389 | prop: reduce [r-tile r-dual r-diam r-truchet r-diag] 390 | either zero? sp: sum prop [ 391 | prop: [20 20 20 20 20] 392 | norm: 1 393 | ][ 394 | norm: 100.0 / sp 395 | ] 396 | forall prop [prop/1: to-integer norm * prop/1] 397 | 398 | big-img: make image! [1920x1080 0.0.0.255] 399 | 400 | ;probe conds 401 | ;probe conds-screen 402 | 403 | cond: either img? [conds-big][conds-screen] 404 | ;init-cells get cur-rule conds-big cell-sz 5000 5000 rotation 405 | init-cells get cur-rule cond cell-sz 5000 5000 rotation 406 | while [not empty? cells-to-check][ 407 | make-cells 408 | n: n + 1 409 | prog/data: n / count 410 | ] 411 | 412 | random/seed rndseed 413 | coords: draw-cells 414 | clear grid 415 | append clear grid compose [fill-pen (bgcolor) box 0x0 1920x1080 line-cap round line-join round] 416 | bg: on 417 | if shadow? [ 418 | append grid compose [line-width (10 * shadowsz) pen (shadowcolor)] 419 | foreach c coords [ 420 | append grid render-cell c prop 421 | n: n + 1 422 | prog/data: n / count 423 | ] 424 | ] 425 | bg: off 426 | change at find grid-front 'color 3 line-color 427 | change at find grid-front 'thick 3 10 * cell-width 428 | append grid grid-front 429 | ;--------- 430 | append grid [scale-factor: scale 1 1] 431 | ; 432 | random/seed rndseed 433 | foreach c coords [ 434 | append grid render-cell c prop 435 | n: n + 1 436 | prog/data: n / count 437 | ] 438 | t2: now/time/precise 439 | ;print ["Image generated for" t2 - t1 "seconds"] 440 | draw big-img grid 441 | ] 442 | 443 | update-clr: function [ 444 | r g b 445 | ][ 446 | as-color to-integer 255 * r 447 | to-integer 255 * g 448 | to-integer 255 * b 449 | ] 450 | 451 | get-color: func [ 452 | caller 453 | color 454 | /local clr r g b 455 | ][ 456 | changed: false 457 | caller/enabled?: false 458 | 459 | col: get color 460 | r: 100% * col/1 / 255 461 | g: 100% * col/2 / 255 462 | b: 100% * col/3 / 255 463 | view/flags compose [ 464 | title "Pick a color" 465 | across 466 | b-red: base 25x25 red 467 | sl-red: slider 256x25 (r) [ 468 | f-red/data: to-integer 255 * sl-red/data 469 | clr/color: update-clr sl-red/data sl-green/data sl-blue/data 470 | ] 471 | f-red: field 32x25 (to-string col/1) on-key-up [ 472 | sl-red/data: (any [f-red/data 0]) / 255 473 | clr/color: update-clr sl-red/data sl-green/data sl-blue/data 474 | ] 475 | return 476 | b-green: base 25x25 green 477 | sl-green: slider 256x25 (g) [ 478 | f-green/data: to-integer 255 * sl-green/data 479 | clr/color: update-clr sl-red/data sl-green/data sl-blue/data 480 | ] 481 | f-green: field 32x25 (to-string col/2) on-key-up [ 482 | sl-green/data: (any [f-green/data 0]) / 255 483 | clr/color: update-clr sl-red/data sl-green/data sl-blue/data 484 | ] 485 | return 486 | b-blue: base 25x25 blue 487 | sl-blue: slider 256x25 (b) [ 488 | f-blue/data: to-integer 255 * sl-blue/data 489 | clr/color: update-clr sl-red/data sl-green/data sl-blue/data 490 | ] 491 | f-blue: field 32x25 (to-string col/3) on-key-up [ 492 | sl-blue/data: (any [f-blue/data 0]) / 255 493 | clr/color: update-clr sl-red/data sl-green/data sl-blue/data 494 | ] 495 | return 496 | clr: base 260x60 (col) 497 | below 498 | button 60x25 "Cancel" [unview] 499 | button 60x25 "OK" [changed: true unview] 500 | ][modal no-min no-max] 501 | 502 | caller/enabled?: true 503 | either changed [set color clr/color clr/color][col] 504 | ] 505 | 506 | ;initial screen 507 | make-thumbs 508 | cur-rule: 'r4 509 | line-color: 42.120.150 510 | 511 | base-c: 0.1 512 | 513 | view compose/deep [ 514 | title "TruTiles" 515 | 516 | space 5x5 517 | presets: drop-list 245x20 518 | button 45x23 "Load" 519 | return 520 | preset: field 245x23 521 | button 45x23 "Save" 522 | return 523 | 524 | group-box [ 525 | across middle 526 | text "Cell Size" sl-size: slider 132x20 17.5% 527 | [t-size/data: cell-sz: round/to to-integer 200 * sl-size/data + 15 1] 528 | t-size: text (form cell-sz) 40x20 return 529 | text "Rotation" sl-rotation: slider 132x20 0% 530 | [t-rot/data: rotation: to-integer 120 * sl-rotation/data] 531 | t-rot: text (form rotation) 30x20 return 532 | text "Line Width" sl-thick: slider 132x20 5% 533 | [t-line/data: cell-width: to-integer 50 * sl-thick/data + 1] 534 | t-line: text (form cell-width) 32x20 return 535 | text "Line Color" b-linecolor: base 25x25 42.120.150 536 | on-up [ 537 | b-linecolor/color: get-color b-linecolor 'line-color 538 | t-linecolor/data: line-color 539 | ] 540 | t-linecolor: text (form line-color) 60x20 return 541 | text "Background" b-bgcolor: base 25x25 aqua 542 | on-up [ 543 | b-bgcolor/color: get-color b-bgcolor 'bgcolor 544 | t-bgcolor/data: bgcolor 545 | ] 546 | t-bgcolor: text (form bgcolor) 60x20 547 | ] return 548 | group-box [ 549 | tshadow: check "Shadow" 65x20 off [shadow?: tshadow/data] 550 | text "Shadow Color" b-shadowcolor: base 25x25 white 551 | on-up [ 552 | b-shadowcolor/color: get-color b-shadowcolor 'shadowcolor 553 | t-shadowcolor/data: shadowcolor 554 | ] 555 | t-shadowcolor: text (form shadowcolor) 60x20 556 | return 557 | text "Shadow Width" sl-shadsz: slider 132x20 18% 558 | [t-shadowsz/data: shadowsz: to-integer 50 * sl-shadsz/data + 1] 559 | t-shadowsz: text (form shadowsz) 30x20 return 560 | text "Shadow Offset" sl-shadoffs: slider 132x20 50% 561 | [shadowoffs: 500x500 * sl-shadoffs/data - 250x250 562 | t-shadowoffs/data: to-integer shadowoffs/x / 10] 563 | t-shadowoffs: text "0" 40x20 return 564 | ] return 565 | group-box [ 566 | text "Tile" sl-tile: slider 132x20 100% 567 | [t-tile/data: r-tile: to-integer 100 * sl-tile/data] 568 | t-tile: text (form r-tile) 40x20 return 569 | text "Dual" sl-dual: slider 132x20 570 | [t-dual/data: r-dual: to-integer 100 * sl-dual/data] 571 | t-dual: text (form r-dual) 30x20 return 572 | text "Diamond" sl-diam: slider 132x20 573 | [t-diam/data: r-diam: to-integer 100 * sl-diam/data] 574 | t-diam: text (form r-diam) 30x20 return 575 | text "Truchet" sl-truchet: slider 132x20 576 | [t-truchet/data: r-truchet: to-integer 100 * sl-truchet/data] 577 | t-truchet: text (form r-truchet) 30x20 return 578 | text "Diagonal" sl-diag: slider 132x20 579 | [t-diag/data: r-diag: to-integer 100 * sl-diag/data] 580 | t-diag: text (form r-diag) 30x20 581 | ] return 582 | 583 | f-rand: field 95x25 hint "Random seed" 584 | button 95x25 "Render" [render-grid false] 585 | button 95x25 "Save .png" 586 | [render-grid true save/as request-file/save/file/filter %TruTiles.png [%png] big-img 'png] 587 | return 588 | prog: progress 300x5 0% 589 | 590 | space 5x5 591 | below return 592 | b-r4: base 100x100 draw [image (r4-img)(frame)] [select-thumb 'r4] 593 | b-r3: base 100x100 draw [image (r3-img)] [select-thumb 'r3] 594 | b-r6: base 100x100 draw [image (r6-img)] [select-thumb 'r6] 595 | b-r6-3: base 100x100 draw [image (r6-3-img)] [select-thumb 'r6-3] 596 | b-r6-3-3: base 100x100 draw [image (r6-3-3-img)] [select-thumb 'r6-3-3] 597 | b-r6-4-3: base 100x100 draw [image (r6-4-3-img)] [select-thumb 'r6-4-3] 598 | return 599 | b-r8-4: base 100x100 draw [image (r8-4-img)] [select-thumb 'r8-4] 600 | b-r12-3: base 100x100 draw [image (r12-3-img)] [select-thumb 'r12-3] 601 | b-r12-6-4: base 100x100 draw [image (r12-6-4-img)] [select-thumb 'r12-6-4] 602 | b-r4-3: base 100x100 draw [image (r4-3-img)] [select-thumb 'r4-3] 603 | b-r4-3a: base 100x100 draw [image (r4-3a-img)] [select-thumb 'r4-3a] 604 | radio "Side" on 605 | radio "Line" 606 | radio "Shadow" 607 | 608 | space 8x5 609 | return 610 | scr: base 800x645 ;rate 30 611 | draw grid 612 | on-create [render-grid false] 613 | ;on-time [base-c: base-c * 1.1 % 3 scale-factor/2: base-c scale-factor/3: base-c] 614 | ] 615 | -------------------------------------------------------------------------------- /Truchet.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/GalenIvanov/Graphics-Red/7d94de28142b2724962a7fa306c82295866fa874/Truchet.jpg -------------------------------------------------------------------------------- /stickman.red: -------------------------------------------------------------------------------- 1 | Red [ 2 | Title: "Stick figures tests" 3 | Author: "Galen Ivanov" 4 | Needs: view 5 | ] 6 | 7 | stickman: function [ 8 | pos [pair!] 9 | size [integer!] 10 | color [tuple!] 11 | ][ 12 | c: size / 20 13 | r-head: to-integer c * 20 14 | r-hand: to-integer c * 10 15 | r-gap: to-integer c * 3 16 | l-hand: to-integer c * 80 17 | c-head: c * 50x25 + pos 18 | c-neck: c * 50x50 + pos 19 | width: to-integer c * 20 20 | 21 | collect [ 22 | keep compose/deep [ 23 | fill-pen (color) 24 | circle (c-head) (r-head) 25 | shape [ 26 | move (c-neck) 27 | 'hline (0 - width - (3 * r-gap)) 28 | 'arc (-1x1 * r-head) (r-head) (r-head) 0 29 | 'vline (l-hand) 30 | 'arc (2x0 * r-hand) (r-hand) (r-hand) 0 31 | 'vline (0 - l-hand + r-hand) 32 | 'arc (2x0 * r-gap) (r-gap) (r-gap) 0 sweep 33 | 'vline (2 * l-hand) 34 | 'arc (2x0 * r-hand) (r-hand) (r-hand) 0 35 | 'vline (0 - l-hand - r-hand) 36 | 'arc (2x0 * r-gap) (r-gap) (r-gap) 0 sweep 37 | 'vline (l-hand + r-hand) 38 | 'arc (2x0 * r-hand) (r-hand) (r-hand) 0 39 | 'vline (0 - 2 * l-hand) 40 | 'arc (2x0 * r-gap) (r-gap) (r-gap) 0 sweep 41 | 'vline (l-hand - r-hand) 42 | 'arc (2x0 * r-hand) (r-hand) (r-hand) 0 43 | 'vline (0 - l-hand) 44 | 'arc (-1x-1 * r-head) (r-head) (r-head) 0 45 | 'hline (0 - width - (4 * r-gap)) 46 | ] 47 | ] 48 | ] 49 | ] 50 | 51 | stickwoman: function [ 52 | pos [pair!] 53 | size [integer!] 54 | color [tuple!] 55 | ][ 56 | c: size / 20 57 | r-head: to-integer c * 20 58 | r-hand: to-integer c * 9 59 | r-gap: to-integer c * 3 60 | l-hand: to-integer c * 70 61 | c-head: c * 50x25 + pos 62 | c-neck: c * 50x50 + pos 63 | width: to-integer c * 15 64 | 65 | collect [ 66 | keep compose/deep [ 67 | fill-pen (color) 68 | circle (c-head) (r-head) 69 | shape [ 70 | move (c-neck) 71 | 'hline (0 - width - (3 * r-gap)) 72 | 'arc (-1x1 * r-head) (r-head) (r-head + 10) 0 73 | 'line (as-pair 0 - r-hand * 2 l-hand) 74 | 'arc (2x1 * r-hand) (r-hand) (r-hand) 0 75 | 'line (as-pair r-hand * 2 0 - l-hand) 76 | 'arc (2x1 * r-gap) (r-gap) (r-gap) 0 sweep 77 | 'line (as-pair 0 - r-hand * 3 l-hand + (3 * r-hand)) 78 | 'hline (3 * r-hand) 79 | 'vline (l-hand - r-hand) 80 | 'arc (2x0 * r-hand) (r-hand) (r-hand) 0 81 | 'vline (0 - l-hand + r-hand) 82 | 'hline (2 * r-gap) 83 | 'vline (l-hand - r-hand) 84 | 'arc (2x0 * r-hand) (r-hand) (r-hand) 0 85 | 'vline (0 - l-hand + r-hand) 86 | 'hline (3 * r-hand) 87 | 'line (as-pair 0 - r-hand * 3 0 - l-hand - (3 * r-hand)) 88 | 'arc (2x-1 * r-gap) (r-gap) (r-gap) 0 sweep 89 | 'line (as-pair r-hand * 2 l-hand) 90 | 'arc (2x-1 * r-hand) (r-hand) (r-hand) 0 91 | 'line (as-pair 0 - r-hand * 2 0 - l-hand) 92 | 'arc (-1x-1 * r-head) (r-head) (r-head + 10) 0 93 | 'hline (0 - width - (4 * r-gap)) 94 | ] 95 | ] 96 | ] 97 | ] 98 | view compose/deep [ 99 | title "Stickman tests" 100 | base 250x300 beige 101 | draw [ 102 | (stickman 20x20 16 black) 103 | (stickwoman 140x20 16 pink) 104 | ] 105 | ] --------------------------------------------------------------------------------