Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Experiments with L-System
Red [
Author: "Toomas Vooglaid"
Date: 25-9-2017
Description: {Experiments with L-System}
Last-update: 26-9-2017
Uses: {%models.red https://gist.github.com/toomasv/313e1d8583fb159428222651b76926cd}
Repo: https://github.com/toomasv/l-system
]
context [
ctx: self
scale: origin: length: len: angle: width: delta-width: times-length: none
delta-length: delta-len: delta-angle: anti-aliasing?: stack: commands: none
_L: _U: _X: _Origin: _Scale: _Length: _Angle: _Len: _Width: _Delta-width: none
_Delta-length: _Delta-len: _Times-length: _Delta-angle: _Anti-aliasing?: none
_Drop: str1: str: iter: lang: U: X: none
defaults: [
scale 2.0
origin 300x500
length 0x100
len 100
angle 90
width 1
delta-width 1
times-length 2
delta-length 0x10
delta-len 10
delta-angle 15
anti-aliasing? yes
]
drawing: [
#"U" [line 0x0 (length) translate (length)]
#"L" [line 0x0 (length) translate (length)]
#"M" [translate (length)]
#"l" ['line (length)]
#"h" ['hline (len)]
#"v" ['vline (len)]
#"m" ['move (length)]
#"+" [rotate (negate angle)]
#"-" [rotate (angle)]
#"|" [rotate 180]
#"&" [swap next find drawing #"+" next find drawing #"-"]
;#"[" []
;#"]" []
;#"{" []
;#"}" []
#"#" [line-width (width: width + delta-width)]
#"!" [line-width (width: width - delta-width)]
#"@" [circle 0x0 (width)]
#">" [length: length * times-length len: len * times-length]
#"<" [length: length / times-length len: len / times-length]
#"(" [angle: angle - delta-angle]
#")" [angle: angle + delta-angle]
#"´" [length: length + delta-length len: len + delta-len]
#"`" [length: length - delta-length len: len - delta-len]
]
set-opts: func [opts iter /local word value][
stack: copy [] commands: copy []
foreach [word value] self/defaults [self/:word: value]
put drawing #"+" [rotate (negate angle)]
put drawing #"-" [rotate (angle)]
if opts [opts: compose opts foreach [word value] opts [self/:word: value]]
]
expand: func [str iter][
either iter > 0 [
str: loop iter [
str: rejoin parse/case str compose [
collect some [
set elem skip
if (find extract language 2 elem)
keep (select language elem)
| keep skip
]
]
]
][str]
]
make-commands: func [str iter /local symb cmd scl][
length: either iter > 0 [length / (2 * iter)][length]
parse str [some [
set symb [#"<" | #">" | #"&" | #"(" | #")" | #"´" | #"`"] (do select drawing symb)
| [#"[" | #"{"] (insert/only stack commands commands: copy [])
| set symb [#"]"| #"}"] (
commands: either empty? commands [
take stack
][
switch symb [
#"]" [append append/only append take stack 'push copy commands [pen black]]
#"}" [append/only append take stack 'shape head insert copy commands [move 0x0]]
]
]
)
| set symb skip (append commands compose/deep either cmd: select drawing symb [cmd][[]])
]]
scl: either iter > 0 [scale / iter][1]
insert commands compose/deep [
anti-alias (either anti-aliasing? ['on]['off])
line-width (width)
matrix [(scl) 0 0 (negate scl) (origin/x) (origin/y)]
]
]
models: load https://tinyurl.com/ycevdrxe
chars: [#"L" #"U" #"X"]
set-fields: func [model /local char lang vals][
forall chars [
put self/(to-word rejoin ["_" chars/1]) 'text either lang: select model/language chars/1 [lang][""]
]
set-opts model/options model/iterations
vals: extract defaults 2
forall vals [
put self/(to-word rejoin ["_" vals/1]) 'data get vals/1
]
_Initial/text: model/initial
_Iterations/data: model/iterations
]
show-current: does [
set-opts reduce [
'origin _Origin/data 'scale _Scale/data 'length _Length/data
'angle _Angle/data 'len _Len/data 'width _Width/data 'delta-width _Delta-width/data
'delta-length _Delta-length/data 'delta-len _Delta-len/data
'times-length _Times-length/data 'delta-angle _Delta-angle/data
'anti-aliasing? _Anti-aliasing?/data
] _Iterations/data
language: reduce [#"L" _L/text]
unless empty? _U/text [append language reduce [#"U" _U/text]]
unless empty? _X/text [append language reduce [#"X" _X/text]]
make-commands expand _Initial/text _Iterations/data _Iterations/data
_Img/draw: commands
]
set-opts models/1/options iter: models/1/iterations
language: models/1/language
str1: expand str: models/1/initial models/1/iterations
make-commands str1 models/1/iterations
win: view/no-wait compose/deep [
tab-panel [
"Graphics" [
group-box "Options" [
text "Origin:" 50 _Origin: field 65 (to-string origin)
text "Width:" 50 _Width: field 65 (to-string width)
text "Length:" 55 _Length: field 65 (to-string length)
text "Len:" 50 _Len: field 65 (to-string len)
text "Angle:" 50 _Angle: field 65 (to-string angle)
return
text "Scale:" 50 _Scale: field 65 (to-string scale)
text "D-width:" 50 _Delta-width: field 65 (to-string delta-width)
text "D-Length:" 55 _Delta-length: field 65 (to-string delta-length)
text "D-Len:" 50 _Delta-len: field 65 (to-string delta-len)
text "D-angle:" 50 _Delta-angle: field 65 (to-string delta-angle)
return
text "L:" 15 _L: field 146 hint "Rule for L" (select language #"L")
text "U:" 15 _U: field 147 hint "Rule for U" (either U: select language #"U" [U][""])
text "X:" 15 _X: field 147 hint "Rule for X" (either X: select language #"X" [X][""])
text "T-length:" 50 _Times-length: field 65 (to-string times-length)
return
text "Model:" 40 _Drop: drop-list data [(drop: copy [] forall models [append drop models/1/title] drop)] select 1 on-change [
set-fields pick models face/selected
show-current
]
text "Initial:" 35 _Initial: field 100 (to-string str)
text "Iterations:" 55 _Iterations: field 20 (to-string iter) pad 5x0
_Anti-aliasing?: check "Anti-aliasing?" data (anti-aliasing?) pad 7x0
button "<" 25 [
_Iterations/data: _Iterations/data - 1
show-current
]
button ">" 25 [
_Iterations/data: _Iterations/data + 1
show-current
]
button "Show" 65 [show-current]
]
return
_Img: image 700x600
draw [(commands)]
]
"Instructions" [space 10x5
text "X" 20 text "For controlling repetition patterns only. Not directly drawn." return
text "L" 20 text "Inserts a line with dimensions of `length` and moves turtle to the end of this line." return
text "U" 20 text "Same as U. Needed for different repetition patterns in language." return
text "M" 20 text "Moves turtle by dimensions of `length`." return
text "l" 20 text "Draws line of `length` dimensions in shape and moves turtle to the end of this line." return
text "h" 20 text "Draws horizontal line of length `len` in shape block and moves to the end of the line." return
text "v" 20 text "Draws vertical line of length `len` in shape block and moves to the end of the line." return
text "m" 20 text "Moves turtle in shape block by `length`." return
text "+" 20 text "Rotates head of the turtle by `angle` degrees to right." return
text "-" 20 text "Rotates head of the turtle by `angle` degrees to left." return
text "|" 20 text "Rotates head of the turtle by 180 degrees." return
text "&&" 20 text "Swaps directions of `+` and `-`." return
text "[" 20 text "Opens `push` block" return
text "]" 20 text "Closes `push` block" return
text "{" 20 text "Opens `shape` block" return
text "}" 20 text "Closes `shape` block" return
text "#" 20 text "Increases line-width by `delta-width`." return
text "!" 20 text "Decreases line-width by `delta-width`." return
text "@" 20 text "Draws circle with radius of `width`." return
text ">" 20 text "Increases `length` and `len` `times-length` times." return
text "<" 20 text "Decreases `length` and `len` `times-length` times." return
text ")" 20 text "Increases angle by `delta-angle`." return
text "(" 20 text "Decreases angle by `delta-angle`." return
text "´" 20 text "Increases `length` and `len` by `delta-length`." return
text "`" 20 text "Decreases `length` and `len` by `delta-length`." return
]
]
]
set-fields pick models 1
win
do-events
]
@toomasv

This comment has been minimized.

Copy link
Owner Author

@toomasv toomasv commented Sep 25, 2017

Work in progress. Don't be surprised stumbling on bugs.

@dockimbel

This comment has been minimized.

Copy link

@dockimbel dockimbel commented Sep 26, 2017

At line 65, why not use pure Parse rules instead of the if (find ...) (...) constructs? Did I miss something?

@toomasv

This comment has been minimized.

Copy link
Owner Author

@toomasv toomasv commented Sep 26, 2017

Thanks for pointing out! Corrected.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.