Skip to content

Instantly share code, notes, and snippets.

@maximvl

maximvl/l-system.red

Forked from toomasv/l-system.red
Created Sep 25, 2017
Embed
What would you like to do?
Red [
Author: "Toomas Vooglaid"
Date: 25-9-2017
Description: {Experiments with L-System}
]
ctx: context [
scale: origin: length: len: angle: width: delta-width: times-length: delta-length: delta-angle: aliasing?: stack: commands: none
defaults: [
scale 2.0
origin 300x500
length 0x100
len 100
angle 90;22.5;45;
width 1
delta-width 1
times-length 2
delta-length 0x10
delta-angle 15
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-length]
#"`" [length: length - delta-length len: len - delta-length]
]
set 'l-system func [str iter /with opts /local word value scl1 scl2 cmd][
stack: copy [] commands: copy []
foreach [word value] self/defaults [self/:word: value]
put drawing #"+" [rotate (negate angle)]
put drawing #"-" [rotate (angle)]
if with [foreach [word value] opts [self/:word: value]]
length: either iter > 0 [length / (2 * iter)][length]
if 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
]
] ] ]
;probe str
parse str [some [
set symb skip [
if (find [#"<" #">" #"&" #"(" #")" #"´" #"`"] symb) (do select drawing symb)
| if (find [#"[" #"{"] symb) (insert/only stack commands commands: copy [])
| if (find [#"]" #"}"] 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]]
]
]
)
| (append commands compose/deep either cmd: select drawing symb [cmd][[]])
]
]]
;probe commands
scl1: scl2: either iter > 0 [scale / iter][scale]
view/no-wait compose/deep [
image 700x600
draw [
anti-alias (aliasing?)
;line-width (width)
matrix [(scl1) 0 0 (negate scl2) (origin/x) (origin/y)]
(commands)
]
]
]
]
comment {
; Blocky 1
language: [#"L" "L+L-L-LL+L+L-L"]
l-system/with "L+L+L+L" iter: 3 opts: [angle 90 length 0x100 scale 1.0 origin 200x450]
;-----------
; Blocky 2
language: [#"L" "LL+L-L+L+LL"] ; FF-F+F-F-FF
l-system/with "L+L+L+L" iter: 4 opts: [angle 90 length 100x0 scale 2.0 origin 200x300]
;-----------
; Weed 1
language: [
#"L" "LL"
#"X" "L-[[X]+X]+L[+LX]-X" ;F-[[X]+X]+F[+FX]-X
]
l-system/with "X" iter: 6 opts: [angle 22.5 length 30x100 scale 2.0 origin 300x570]
; Weed in wind
language: [
#"L" "LL"
#"X" "L-[[X]-X]+L[-LX]-X" ;F-[[X]+X]+F[+FX]-X
]
l-system/with "&X" iter: 6 opts: [angle 22.5 length 30x100 scale 2.0 origin 300x570]
;-----------
; Weed 3
language: [
#"U" "L[+U]-U"
#"L" "LL"
]
l-system/with "U" 7 opts: [angle 45 length 0x100 scale 3.0 origin 350x580]
;-----------
; Spiral
language: [#"L" "L+U" #"U" "´L+U"] l-system/with "L" 5 [origin 350x300 scale 4.0]
;-----------
; Koch curve
language: [#"L" "L-L+L+L-L"] l-system/with "+L" 3 [angle 90 origin 150x380]
;-----------
; Sierpinski
language: [#"L" "L-U+L+U-L" #"U" "UU"]
l-system/with "L-U-U" 6 [length 100x0 angle 120 origin 50x580 scale 6.0]
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment