Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss
L-systems in PS
105 views
Skip to first unread message
luser- -droog
Jul 26, 2012, 2:34:19 AM7/26/12
to
I've brought up L-systems before in these threads,
but always apropos of something else.
Topic: 3D in PS
https://groups.google.com/forum/?fromgroups#!topic/comp.lang.postscript/5K0-ZRsFjNg
Topic: Sierpinski Triangles
https://groups.google.com/forum/?fromgroups#!topic/comp.lang.postscript/tIkud9Ug0Vc
Topic: Koch Snowflake using Lindenmeyer[sic] system
https://groups.google.com/forum/?fromgroups#!topic/comp.lang.postscript/5xKJBYOhmP4
But now I've read further into
http://algorithmicbotany.org/papers/#abop
and I want to do some fancier stuff.
Firstly, note to self: it's '-may'er, not '-mey'er.
So, Josh, stop spelling it wrong all over the place!
Next. There are some issues with the code.
Building and discarding ginormous arrays
of hundreds of thousands of elements
is not really 'using the stack properly'.
When I tried to implement the plant example,
http://en.wikipedia.org/wiki/L-system#Example_7:_Fractal_plant
I wanted to get more detail than the wikipedia picture.
But when I cranked it up to 7 iterations,
Poof! Stackoverflow. Seems to happen around 65535.
So this example extends the plant example,
by substituting but not expanding the subprocedures.
I also added a little nondeterminism experiment
and a UNIX-only (sorry) randomized seed.
Finite (but large) possibilities, infinite loop.
%!
%Reference:
%http://en.wikipedia.org/wiki/L-system#Example_7:_Fractal_plant
%
0 4{ 8 bitshift (/dev/random)(r)file read pop add }repeat srand
<< %start constructing a dictionary
%Deterministic Context-Free L-System
%simulated by repeated macro-expansion
%of elements in the array with definitions
%in the currentdict
% proc(ie. array) repeat-count DOL expanded-proc
/DOL { % arr M
{ % arr
[ exch % [ arr
{ % [ ... arr_N perform substitutions on each element
currentdict exch 2 copy known % [ ... dict arr_N bool
{get aload pop}{exch pop}ifelse % [ ... arr_N'
} forall % [ arr_0 arr_1 ... arr_N-1
] % arr' zip up array
dup length = %report size of proc
dup 0 exch { /X eq { 1 add } if } forall = %how many 'X's
dup 0 exch { /F eq { 1 add } if } forall = %how many 'F's
()= %blank line
} repeat % arr'^M array transformed M times
cvx % convert array to proc
}
/DDOLstep { [ exch {
dup type /arraytype eq {
DDOLstep
}{
currentdict exch
2 copy known {
get exec
}{
exch pop
} ifelse
} ifelse
} forall ] } def
/DDOL { //DDOLstep repeat }
/Dexec {
{
dup type /arraytype eq {
Dexec
}{
exec
} ifelse
} forall
}
%transformations (Productions)
/X {
rand 3 mod 0 eq
{{F -[X]+ [X]+ [X]+}}
{{F -[[X]+ X]+ F[+ F X]- X}}
ifelse
}
/F {
rand 3 mod 0 eq
{{G F}}
{{F F}}
ifelse
}
>>begin %define DOL and transformations
{
/Courier 10 selectfont 50 750 moveto rrand 12 string cvs show
{X} % seed-proc
8 DDOL % expanded-proc
<< % graphical interpretation of expanded proc
([){gsave}
(]){%currentpoint 1 0 180 arc stroke
grestore}
/X{}
/F{0 r rlineto currentpoint stroke moveto}
/G 1 index
/r 1
/a 25
/-{a rotate}
/+{a neg rotate}
>>begin %define interpretation
300 40 moveto %establish currentpoint
.5 setlinewidth
Dexec %execute the proc
showpage
end
}loop
but always apropos of something else.
Topic: 3D in PS
https://groups.google.com/forum/?fromgroups#!topic/comp.lang.postscript/5K0-ZRsFjNg
Topic: Sierpinski Triangles
https://groups.google.com/forum/?fromgroups#!topic/comp.lang.postscript/tIkud9Ug0Vc
Topic: Koch Snowflake using Lindenmeyer[sic] system
https://groups.google.com/forum/?fromgroups#!topic/comp.lang.postscript/5xKJBYOhmP4
But now I've read further into
http://algorithmicbotany.org/papers/#abop
and I want to do some fancier stuff.
Firstly, note to self: it's '-may'er, not '-mey'er.
So, Josh, stop spelling it wrong all over the place!
Next. There are some issues with the code.
Building and discarding ginormous arrays
of hundreds of thousands of elements
is not really 'using the stack properly'.
When I tried to implement the plant example,
http://en.wikipedia.org/wiki/L-system#Example_7:_Fractal_plant
I wanted to get more detail than the wikipedia picture.
But when I cranked it up to 7 iterations,
Poof! Stackoverflow. Seems to happen around 65535.
So this example extends the plant example,
by substituting but not expanding the subprocedures.
I also added a little nondeterminism experiment
and a UNIX-only (sorry) randomized seed.
Finite (but large) possibilities, infinite loop.
%!
%Reference:
%http://en.wikipedia.org/wiki/L-system#Example_7:_Fractal_plant
%
0 4{ 8 bitshift (/dev/random)(r)file read pop add }repeat srand
<< %start constructing a dictionary
%Deterministic Context-Free L-System
%simulated by repeated macro-expansion
%of elements in the array with definitions
%in the currentdict
% proc(ie. array) repeat-count DOL expanded-proc
/DOL { % arr M
{ % arr
[ exch % [ arr
{ % [ ... arr_N perform substitutions on each element
currentdict exch 2 copy known % [ ... dict arr_N bool
{get aload pop}{exch pop}ifelse % [ ... arr_N'
} forall % [ arr_0 arr_1 ... arr_N-1
] % arr' zip up array
dup length = %report size of proc
dup 0 exch { /X eq { 1 add } if } forall = %how many 'X's
dup 0 exch { /F eq { 1 add } if } forall = %how many 'F's
()= %blank line
} repeat % arr'^M array transformed M times
cvx % convert array to proc
}
/DDOLstep { [ exch {
dup type /arraytype eq {
DDOLstep
}{
currentdict exch
2 copy known {
get exec
}{
exch pop
} ifelse
} ifelse
} forall ] } def
/DDOL { //DDOLstep repeat }
/Dexec {
{
dup type /arraytype eq {
Dexec
}{
exec
} ifelse
} forall
}
%transformations (Productions)
/X {
rand 3 mod 0 eq
{{F -[X]+ [X]+ [X]+}}
{{F -[[X]+ X]+ F[+ F X]- X}}
ifelse
}
/F {
rand 3 mod 0 eq
{{G F}}
{{F F}}
ifelse
}
>>begin %define DOL and transformations
{
/Courier 10 selectfont 50 750 moveto rrand 12 string cvs show
{X} % seed-proc
8 DDOL % expanded-proc
<< % graphical interpretation of expanded proc
([){gsave}
(]){%currentpoint 1 0 180 arc stroke
grestore}
/X{}
/F{0 r rlineto currentpoint stroke moveto}
/G 1 index
/r 1
/a 25
/-{a rotate}
/+{a neg rotate}
>>begin %define interpretation
300 40 moveto %establish currentpoint
.5 setlinewidth
Dexec %execute the proc
showpage
end
}loop
luser- -droog
Jul 27, 2012, 1:05:26 PM7/27/12
to
A variant of the previous.
Draws 20-50 randomly-placed trees per page in random colors.
%!
%Reference:
%http://en.wikipedia.org/wiki/L-system#Example_7:_Fractal_plant
%
0 4{ 8 bitshift (/dev/random)(r)file read pop add }repeat srand
/setrandcolor {
rand 100 mod 100 div
rand 100 mod 200 div .5 add
rand 100 mod 300 div .33 add
sethsbcolor
} def
<< %start constructing a dictionary
/DDOLstep { [ exch {
dup type /arraytype eq {
DDOLstep
}{
currentdict exch
2 copy known {
get exec
}{
exch pop
} ifelse
} ifelse
} forall ] } bind def
/DDOL { //DDOLstep repeat }
/Dexec {
{
dup type /arraytype eq {
Dexec
}{
exec
} ifelse
} forall
} bind
%transformations (Productions)
/X {
rand 3 mod 0 eq
{{F -[X]+ [X]+ [X]+}}
{{F -[[X]+ X]+ F[+ F X]- X}}
ifelse
}
/F {
rand 3 mod 0 eq
{{G F}}
{{F F}}
ifelse
}
>>begin %define DOL and transformations
/graphics << % graphical interpretation of expanded proc
([){gsave} bind
(]){%currentpoint r 0 180 arc stroke
grestore} bind
/X{}
/F{0 r rlineto currentpoint stroke moveto} bind
/+{a neg rotate} bind
>> def
{ %showpage loop
rand 30 mod 20 add { %repeat
%/Courier 10 selectfont 50 750 moveto rrand 12 string cvs show
matrix defaultmatrix setmatrix
{X} % seed-proc
%9
rand 7 mod 3 add
DDOL % expanded-proc
graphics begin %define interpretation
%300 40 moveto %establish currentpoint
100 rand 400 mod add
100 rand 200 mod add moveto
.5 setlinewidth
setrandcolor
Dexec %execute the proc
end
}repeat
showpage
}loop
Draws 20-50 randomly-placed trees per page in random colors.
%!
%Reference:
%http://en.wikipedia.org/wiki/L-system#Example_7:_Fractal_plant
%
0 4{ 8 bitshift (/dev/random)(r)file read pop add }repeat srand
rand 100 mod 100 div
rand 100 mod 200 div .5 add
rand 100 mod 300 div .33 add
sethsbcolor
} def
<< %start constructing a dictionary
/DDOLstep { [ exch {
dup type /arraytype eq {
DDOLstep
}{
currentdict exch
2 copy known {
get exec
}{
exch pop
} ifelse
} ifelse
/DDOL { //DDOLstep repeat }
/Dexec {
{
dup type /arraytype eq {
Dexec
}{
exec
} ifelse
} forall
%transformations (Productions)
/X {
rand 3 mod 0 eq
{{F -[X]+ [X]+ [X]+}}
{{F -[[X]+ X]+ F[+ F X]- X}}
ifelse
}
/F {
rand 3 mod 0 eq
{{G F}}
{{F F}}
ifelse
}
>>begin %define DOL and transformations
([){gsave} bind
(]){%currentpoint r 0 180 arc stroke
grestore} bind
/X{}
/F{0 r rlineto currentpoint stroke moveto} bind
/G 1 index
/r 1
/a 25
/-{a rotate} bind
/r 1
/a 25
/+{a neg rotate} bind
>> def
{ %showpage loop
rand 30 mod 20 add { %repeat
%/Courier 10 selectfont 50 750 moveto rrand 12 string cvs show
matrix defaultmatrix setmatrix
{X} % seed-proc
%9
rand 7 mod 3 add
DDOL % expanded-proc
graphics begin %define interpretation
%300 40 moveto %establish currentpoint
100 rand 400 mod add
100 rand 200 mod add moveto
.5 setlinewidth
setrandcolor
Dexec %execute the proc
end
}repeat
showpage
}loop
luser- -droog
Jul 28, 2012, 4:21:29 AM7/28/12
to
A new control structure.
A "safe" randomizer.
Now if only it weren't so damned slow!
The probability input is a little weird.
But this is the way I got tow rok. :)
519(1)03:16 AM:lsys 0> cat sol.ps
%!
%Reference:
%http://algorithmicbotany.org/papers/#abop Section 1.7
%
%"Safe" seed randomizer
{ 0 4{ 8 bitshift (/dev/random)(r)file read pop add }repeat srand } stopped
{ usertime 10 { %can't open file, chop some vegetables
save 128 string 99 2 getinterval 1 vmreclaim pop restore
} repeat usertime 8 bitshift add srand } if
/setrandcolor {
rand 100 mod 400 div %red to green
rand 100 mod 300 div .4 add % .4 .. .73 medium sat
rand 100 mod 300 div .2 add % .2 .. .53 dark to medium
sethsbcolor
} def
%Stochastic control structure "randif-block"
%eg. laboriously simulate a 4-sided die
% false .25 { 1 } randif % 25% chance
% .33 { 2 } randif % 25/75% = 33% chance remaining
% .5 { 3 } randif % 25/50% = 50% chance remaining
% 1 { 4 } randif % if all else fails, 100% chance
% pop % randif yields a bool indicating if anything executed
%
% bool prob proc randif bool
/randif {
3 2 roll { %ifelse a previous proc has already executed
pop pop true
}{
exch % proc prob
1 exch div cvi % invert prob to number of "chances"
rand exch mod % chop random int by chances
0 eq {
exec true
}{
pop false
} ifelse
} ifelse
false .33 {{F[+ F]F[- F]F}} randif
.5 {{F[+ F]F}} randif
1 {{F[- F]F}} randif
pop %true one of these has executed
currentlinewidth .8 mul setlinewidth
currenthsbcolor .05 add dup .9 le {sethsbcolor}
{pop pop pop}ifelse
matrix defaultmatrix setmatrix
{F} % seed-proc
rand 4 mod 5 add % 5 .. 8 iterations
1 rand 10 mod 10 div add setlinewidth % 1 .. 2
%20 exch repeat
loop
A "safe" randomizer.
Now if only it weren't so damned slow!
The probability input is a little weird.
But this is the way I got tow rok. :)
519(1)03:16 AM:lsys 0> cat sol.ps
%!
%Reference:
%http://algorithmicbotany.org/papers/#abop Section 1.7
%
%"Safe" seed randomizer
{ 0 4{ 8 bitshift (/dev/random)(r)file read pop add }repeat srand } stopped
{ usertime 10 { %can't open file, chop some vegetables
save 128 string 99 2 getinterval 1 vmreclaim pop restore
} repeat usertime 8 bitshift add srand } if
/setrandcolor {
rand 100 mod 400 div %red to green
rand 100 mod 300 div .4 add % .4 .. .73 medium sat
rand 100 mod 300 div .2 add % .2 .. .53 dark to medium
sethsbcolor
} def
%Stochastic control structure "randif-block"
%eg. laboriously simulate a 4-sided die
% false .25 { 1 } randif % 25% chance
% .33 { 2 } randif % 25/75% = 33% chance remaining
% .5 { 3 } randif % 25/50% = 50% chance remaining
% 1 { 4 } randif % if all else fails, 100% chance
% pop % randif yields a bool indicating if anything executed
%
% bool prob proc randif bool
/randif {
3 2 roll { %ifelse a previous proc has already executed
pop pop true
}{
exch % proc prob
1 exch div cvi % invert prob to number of "chances"
rand exch mod % chop random int by chances
0 eq {
exec true
}{
pop false
} ifelse
} ifelse
} def
<< %start constructing a dictionary
/DDOLstep { [ exch {
dup type /arraytype eq {
DDOLstep
}{
currentdict exch
2 copy known {
get exec
}{
exch pop
} ifelse
} ifelse
} forall ]
%dup ==
<< %start constructing a dictionary
/DDOLstep { [ exch {
dup type /arraytype eq {
DDOLstep
}{
currentdict exch
2 copy known {
get exec
}{
exch pop
} ifelse
} ifelse
} forall ]
} bind def
/DDOL { //DDOLstep repeat }
/Dexec {
{
dup type /arraytype eq {
Dexec
}{
exec
} ifelse
} forall
} bind
%transformations (Productions)
/F {
/DDOL { //DDOLstep repeat }
/Dexec {
{
dup type /arraytype eq {
Dexec
}{
exec
} ifelse
} forall
} bind
%transformations (Productions)
false .33 {{F[+ F]F[- F]F}} randif
.5 {{F[+ F]F}} randif
1 {{F[- F]F}} randif
pop %true one of these has executed
}
>>begin %define DOL and transformations
/graphics << % graphical interpretation of expanded proc
([){gsave %narrower, lighter branches
>>begin %define DOL and transformations
/graphics << % graphical interpretation of expanded proc
currentlinewidth .8 mul setlinewidth
currenthsbcolor .05 add dup .9 le {sethsbcolor}
{pop pop pop}ifelse
} bind
(]){%currentpoint r 0 180 arc stroke
grestore} bind
/X{}
/F{0 r rlineto currentpoint stroke moveto} bind
/G 1 index
/r .5
(]){%currentpoint r 0 180 arc stroke
grestore} bind
/X{}
/F{0 r rlineto currentpoint stroke moveto} bind
/G 1 index
/a 25
/-{a rotate} bind
/+{a neg rotate} bind
>> def
{ %showpage loop
/-{a rotate} bind
/+{a neg rotate} bind
>> def
{ %showpage loop
/Courier 10 selectfont 50 750 moveto rrand 12 string cvs show
rand 20 mod 20 add { %repeat 20 .. 40 "weeds"
matrix defaultmatrix setmatrix
{F} % seed-proc
rand 4 mod 5 add % 5 .. 8 iterations
DDOL % expanded-proc
graphics begin %define interpretation
%300 40 moveto %establish currentpoint
100 rand 400 mod add
100 rand 200 mod add moveto % (100,100) .. (500,300)
graphics begin %define interpretation
%300 40 moveto %establish currentpoint
100 rand 400 mod add
1 rand 10 mod 10 div add setlinewidth % 1 .. 2
setrandcolor
Dexec %execute the proc
end
}repeat
showpage
}
% select finite or infinite loop
Dexec %execute the proc
end
}repeat
showpage
}
%20 exch repeat
loop
luser- -droog
Jul 28, 2012, 5:13:16 PM7/28/12
to
First attempt at a "parametric" L-system.
So parameters evaluate to numbers and then
just occur in the arrays and get used
where needed.
529(1)04:06 PM:lsys 0> cat sunf.ps
%!
%Sunflower Spiral
%From ABOP Section 4.1
<<
/a 137.5
/A {
/n exch def
[ a /+ cvx [ n .5 exp /f cvx /D cvx ] n 1 add /A cvx ] cvx
}
/DOL {
{
[ exch {
}{
exch pop
} ifelse
} forall ]
} repeat cvx
/graphics <<
([) { gsave }
(]) { grestore }
/F { 0 rlineto }
/f { 0 rmoveto }
/+ { rotate }
/- { neg rotate }
/r .5
/innercolor { .5 setgray }
/D { gsave
currentpoint r 0 rmoveto
r 0 360 arc
gsave innercolor fill grestore
stroke
grestore }
>> def
{ 0 A } 500 DOL
300 400 translate
0 0 moveto
20 dup scale
1 20 div setlinewidth
graphics begin
Dexec clear
end
So parameters evaluate to numbers and then
just occur in the arrays and get used
where needed.
529(1)04:06 PM:lsys 0> cat sunf.ps
%!
%Sunflower Spiral
%From ABOP Section 4.1
<<
/a 137.5
/A {
/n exch def
[ a /+ cvx [ n .5 exp /f cvx /D cvx ] n 1 add /A cvx ] cvx
}
/DOL {
{
[ exch {
currentdict exch 2 copy known {
get exec aload pop
}{
exch pop
} ifelse
} forall ]
} repeat cvx
}
/Dexec {
{
dup type /arraytype eq { Dexec }{ exec } ifelse
} forall
}
>>begin
/Dexec {
{
dup type /arraytype eq { Dexec }{ exec } ifelse
} forall
}
/graphics <<
([) { gsave }
(]) { grestore }
/F { 0 rlineto }
/f { 0 rmoveto }
/+ { rotate }
/- { neg rotate }
/r .5
/innercolor { .5 setgray }
/D { gsave
currentpoint r 0 rmoveto
r 0 360 arc
gsave innercolor fill grestore
stroke
grestore }
>> def
{ 0 A } 500 DOL
300 400 translate
0 0 moveto
20 dup scale
1 20 div setlinewidth
graphics begin
Dexec clear
end
tlvp
Jul 28, 2012, 9:59:54 PM7/28/12
to
On Sat, 28 Jul 2012 14:13:16 -0700 (PDT), luser- -droog wrote:
> ... So parameters evaluate to numbers and then
In my book, the terms parameter, index, and (numerical) variable have
always been pretty much interchangeable :-) . HTH. Cheers, -- tlvp
--
Avant de repondre, jeter la poubelle, SVP.
> ... So parameters evaluate to numbers and then
> just occur in the arrays and get used
> where needed. ...
In my book, the terms parameter, index, and (numerical) variable have
always been pretty much interchangeable :-) . HTH. Cheers, -- tlvp
--
Avant de repondre, jeter la poubelle, SVP.
luser- -droog
Jul 28, 2012, 11:41:23 PM7/28/12
to mPiOsUcB...@att.net
On Saturday, July 28, 2012 8:59:54 PM UTC-5, tlvp wrote:
> On Sat, 28 Jul 2012 14:13:16 -0700 (PDT), luser- -droog wrote:
>
>
>
> > ... So parameters evaluate to numbers and then
>
> > just occur in the arrays and get used
>
> > where needed. ...
>
>
>
> In my book, the terms parameter, index, and (numerical) variable have
>
> always been pretty much interchangeable :-) . HTH. Cheers, -- tlvp
>
Well, yeah. It isn't radically different in that respect.
> On Sat, 28 Jul 2012 14:13:16 -0700 (PDT), luser- -droog wrote:
>
>
>
> > ... So parameters evaluate to numbers and then
>
> > just occur in the arrays and get used
>
> > where needed. ...
>
>
>
> In my book, the terms parameter, index, and (numerical) variable have
>
> always been pretty much interchangeable :-) . HTH. Cheers, -- tlvp
>
But it does mean that the productions need to be partially
evaluated at each step. In other cases, the parameter may
select among several productions, as well as evaluate in
the selected procedure.
It turns out I didn't implement the brackets correctly
in that last one, so here's the fixup.
563(1)10:39 PM:lsys 0> cat sunf.ps
%!
%Sunflower Spiral
%From ABOP Section 4.1
<<
/a 137.5
/A {
/n exch def
[ a /+ cvx /[ cvx n .5 exp /f cvx /D cvx /] cvx n 1 add /A cvx ] cvx
%Sunflower Spiral
%From ABOP Section 4.1
<<
/a 137.5
/A {
/n exch def
300 400 translate
0 0 moveto
div setlinewidth
graphics begin
Dexec clear
end
showpage
graphics begin
Dexec clear
end
luser- -droog
Jul 30, 2012, 1:54:25 AM7/30/12
to mPiOsUcB...@att.net
This one was really boring until I realized
that the angle wasn't changing. That fixed,
this one is really really cool.
A simple spiral:
- Forward
- Turn Right
- Forward
- Turn Right
But what if it does little curve instead of
going straight forward?
What if it turns a different angle?
What if it takes an extra odd step?
What then, Huh?
This!
[Hacker Note. Since this one's tail-recursive,
I took out all the Dexec stuff. It's smaller in memory
as flat arrays.]
608(1)12:40 AM:lsys 0> cat spiral.ps
%!
%spiral.ps
%Spirals Galore!
/DOLstep { [ exch {
dup type /arraytype eq {
DOLstep
/graphics <<
([) { gsave }
(]) { grestore }
%/F { 0 rlineto currentpoint stroke moveto }
/F { dup 2 div 1 index 4 div 2 copy
5 4 roll 0 rcurveto
currentpoint stroke moveto }
>> def
/x 90 def
/sys [
<< /a x %90
/A { /n exch def
n /F cvx a /- cvx n /F cvx a /- cvx n 1 add /A cvx
} >>
<< /a x %90
/A { /n exch def
n /F cvx a /- cvx n 1 add /F cvx a /- cvx n 1 add /A cvx
} >>
<< /a x %90
/A { /n exch def
n 1 add /F cvx a /- cvx n /F cvx a /- cvx n 1 add /A cvx
} >>
] def
%80 1 100 { /x exch def } for
[
{ graphics /F { dup 3 div 1 index 4 div 2 copy
5 4 roll 0 rcurveto currentpoint stroke moveto } put }
{ graphics /F { dup 3 div 1 index 4 div 2 copy exch 2 mul exch
5 4 roll 0 rcurveto currentpoint stroke moveto } put }
{ graphics /F { dup 3 div 1 index 4 div 2 copy exch 2 mul exch 1.5 mul
5 4 roll 0 rcurveto currentpoint stroke moveto } put }
{ graphics /F { 0 rlineto currentpoint stroke moveto } put }
]{
exec
0 1 sys length 1 sub {
/y exch def
/x 83 def
1 1 5{
gsave
100 mul 0 moveto
1 1 7{
gsave
100 mul 0 exch rmoveto
/x x 7 add store
gsave
0 50 rmoveto
/Courier 10 selectfont
(a = ) show x ( ) cvs show
grestore
sys y get
dup /a x put
begin
{1 A} 10 DOL
end
%300 400 moveto
1 5 dup dup scale div setlinewidth
graphics begin
exec
end
%showpage
grestore
} for %vertical
grestore
} for %horizontal
showpage
} for %each system variant
} forall %different graphics interpretations of F
that the angle wasn't changing. That fixed,
this one is really really cool.
A simple spiral:
- Forward
- Turn Right
- Forward
- Turn Right
But what if it does little curve instead of
going straight forward?
What if it turns a different angle?
What if it takes an extra odd step?
What then, Huh?
This!
[Hacker Note. Since this one's tail-recursive,
I took out all the Dexec stuff. It's smaller in memory
as flat arrays.]
608(1)12:40 AM:lsys 0> cat spiral.ps
%!
%spiral.ps
%Spirals Galore!
/DOLstep { [ exch {
dup type /arraytype eq {
DOLstep
}{
currentdict exch
2 copy known {
get exec %aload pop
currentdict exch
2 copy known {
}{
exch pop
} ifelse
} ifelse
} forall ]
%dup ==
} bind def
/DOL { //DOLstep repeat cvx } def
exch pop
} ifelse
} ifelse
} forall ]
%dup ==
} bind def
/graphics <<
([) { gsave }
(]) { grestore }
/F { dup 2 div 1 index 4 div 2 copy
5 4 roll 0 rcurveto
currentpoint stroke moveto }
/f { 0 rmoveto }
/+ { rotate }
/- { neg rotate }
/A { pop }
/+ { rotate }
/- { neg rotate }
>> def
/x 90 def
/sys [
<< /a x %90
/A { /n exch def
n /F cvx a /- cvx n /F cvx a /- cvx n 1 add /A cvx
} >>
<< /a x %90
/A { /n exch def
n /F cvx a /- cvx n 1 add /F cvx a /- cvx n 1 add /A cvx
} >>
<< /a x %90
/A { /n exch def
n 1 add /F cvx a /- cvx n /F cvx a /- cvx n 1 add /A cvx
} >>
] def
%80 1 100 { /x exch def } for
[
{ graphics /F { dup 3 div 1 index 4 div 2 copy
5 4 roll 0 rcurveto currentpoint stroke moveto } put }
{ graphics /F { dup 3 div 1 index 4 div 2 copy exch 2 mul exch
5 4 roll 0 rcurveto currentpoint stroke moveto } put }
{ graphics /F { dup 3 div 1 index 4 div 2 copy exch 2 mul exch 1.5 mul
5 4 roll 0 rcurveto currentpoint stroke moveto } put }
{ graphics /F { 0 rlineto currentpoint stroke moveto } put }
]{
exec
0 1 sys length 1 sub {
/y exch def
/x 83 def
1 1 5{
gsave
100 mul 0 moveto
1 1 7{
gsave
100 mul 0 exch rmoveto
/x x 7 add store
gsave
0 50 rmoveto
/Courier 10 selectfont
(a = ) show x ( ) cvs show
grestore
sys y get
dup /a x put
begin
{1 A} 10 DOL
end
%300 400 moveto
1 5 dup dup scale div setlinewidth
graphics begin
exec
end
%showpage
grestore
} for %vertical
grestore
} for %horizontal
showpage
} for %each system variant
} forall %different graphics interpretations of F
luser- -droog
Sep 21, 2012, 2:35:16 AM9/21/12
to
Hacked this up to debug the matrix code for the Steinmetz.
So it's got some dust and crumbs and coffee-stains on it.
And it grows off the page. :(
But, it IS a 3D turtle!
530(1)01:32 AM:ps 0> cat hsc.ps
%!
%3D Turtle Graphics
%Hilbert Space-Curve, ie. "Ramen Noodle"
(mat.ps)run
/div { dup 0 eq { pop 0.000001 } if div } bind def
% Eye coords
/ex 20 def
/ey 20 def
/ez 310 def
/eyedir [ex ey ez neg]
dup mag [ exch dup dup ]{div} vop
def
% x y z -> X Y
/project {
3 dict begin
/z exch def
/y exch def
/x exch def
1 ez z sub div
x ez mul z ex mul sub
1 index mul
y ez mul z ey mul sub
3 2 roll mul
end } def
/State <<
/V [ % Vectors
[ 1 0 0 ] % H^ Heading
[ 0 1 0 ] % L^ Left
[ 0 0 1 ] ] % U^ Up
/P [ 0 0 0 ] % Position
>> def
{
/RU { /a exch def
[[a cos a sin 0 0]
[a sin neg a cos 0 0]
[0 0 1 0]
[0 0 0 1]] } def
/RL { /a exch def
[[a cos 0 a sin neg 0]
[0 1 0 0]
[a sin 0 a cos 0]
[0 0 0 1]] } def
/RH { /a exch def
[[1 0 0 0]
[0 a cos a sin neg 0]
[0 a sin a cos 0]
[0 0 0 1]] } def
} pop
/Turtle <<
/RU { /a exch def
[[a cos a sin 0]
[a sin neg a cos 0]
[0 0 1]] }
/RL { /a exch def
[[a cos 0 a sin neg]
[0 1 0 ]
[a sin 0 a cos ]] }
/RH { /a exch def
[[1 0 0 ]
[0 a cos a sin neg]
[0 a sin a cos ]] }
/F { State /P 2 copy get
State /V get 0 get %pos H^
[R R R] {mul} vop {add} vop %pos+R*H^
dup
aload pop project
pen? {lineto
currentpoint stroke moveto
/flushpage where {pop flushpage} if
}{moveto} ifelse
put
}
/renormalize {
0 1 2 {
State /V get exch 2 copy get
dup mag [ exch dup dup ] {div} vop
put
} for
}
/rot {
{
%pstack
exch %transpose exch % H L U as column vectors
matmul
%transpose %and flip 'em back to make H easy to crack in /F
exit
[ 3 1 roll % [ V R
exch { % [ .. R Vi
%1 array astore transpose
1 index matmul % [ .. R Vi*R
transpose 0 get
exch % [ .. Vi*R R
} forall
pop ]
%dup ==()=
exit } loop
}
/fixup {}%{ renormalize }
/+ { State /V 2 copy get T RU rot put fixup } % turn left
/- { State /V 2 copy get T neg RU rot put fixup } % turn right
/& { State /V 2 copy get T RL rot put fixup } % pitch down
/^ { State /V 2 copy get T neg RL rot put fixup } % pitch up
/, { State /V 2 copy get T RH rot put fixup } % roll left
/. { State /V 2 copy get T neg RH rot put fixup } % roll left
/| { State /V 2 copy get 180 RU rot put fixup } % about face
>> def
/DOL {
}{
exch pop
} ifelse
} ifelse
} forall ] cvx
} def
/Dexec {
{
dup type /arraytype eq {
Dexec
}{
exec
} ifelse
} forall
} def
Turtle begin
<<
/R 20 % "radius" of movement
/T 90 % rotation angle
/pen? true
>> begin
<<
/A { B - F + C F C + F - D & F ^ D - F + & & C F C + F + B . . }
/B { A & F ^ C F B ^ F ^ D ^ ^ - F - D ^ | F ^ B | F C ^ F ^ A . . }
/C { | D ^ | F ^ B - F + C ^ F ^ A & & F A & F ^ C + F + B ^ F ^ D . . }
/D { | C F B - F + B | F A & F ^ A & & F B - F + B | F C . . }
>> begin
<< %T=45
/A { B B B B }
/B { F + C + }
/C { - & A ^ + }
>> pop%begin
<< %T=45
/A { F B - - F B - - F B - - F B - - C }
/B { + . . + A - , , - }
>> pop%begin
<< %T=90
/A { F B }
/B { . & A & A & A & A , }
>> pop%begin
/n 1 def
{
(n =)print n =
50 700 translate
0 0 moveto
1 2 dup dup scale div .8 mul setlinewidth
%2 setlinewidth
%.5 setlinewidth
0 .6 .8 sethsbcolor
%F + F & F - F
%4 { .
% 4 { F + } repeat
%} repeat
%exit}loop currentfile flushfile
{ A } n { DOL } repeat
<< /A {} /B {} /D {}
%/C {}
/C { currenthsbcolor 3 2 roll .1 add dup 1 gt { pop 0 } if 3 1 roll sethsbcolor }
>> begin
Dexec
end
showpage
/n n 1 add def
} loop
So it's got some dust and crumbs and coffee-stains on it.
And it grows off the page. :(
But, it IS a 3D turtle!
530(1)01:32 AM:ps 0> cat hsc.ps
%!
%3D Turtle Graphics
%Hilbert Space-Curve, ie. "Ramen Noodle"
(mat.ps)run
/div { dup 0 eq { pop 0.000001 } if div } bind def
% Eye coords
/ex 20 def
/ey 20 def
/ez 310 def
/eyedir [ex ey ez neg]
dup mag [ exch dup dup ]{div} vop
def
% x y z -> X Y
/project {
3 dict begin
/z exch def
/y exch def
/x exch def
1 ez z sub div
x ez mul z ex mul sub
1 index mul
y ez mul z ey mul sub
3 2 roll mul
end } def
/State <<
/V [ % Vectors
[ 1 0 0 ] % H^ Heading
[ 0 1 0 ] % L^ Left
[ 0 0 1 ] ] % U^ Up
/P [ 0 0 0 ] % Position
>> def
{
/RU { /a exch def
[[a cos a sin 0 0]
[a sin neg a cos 0 0]
[0 0 1 0]
[0 0 0 1]] } def
/RL { /a exch def
[[a cos 0 a sin neg 0]
[0 1 0 0]
[a sin 0 a cos 0]
[0 0 0 1]] } def
/RH { /a exch def
[[1 0 0 0]
[0 a cos a sin neg 0]
[0 a sin a cos 0]
[0 0 0 1]] } def
} pop
/Turtle <<
/RU { /a exch def
[[a cos a sin 0]
[a sin neg a cos 0]
[0 0 1]] }
/RL { /a exch def
[[a cos 0 a sin neg]
[0 1 0 ]
[a sin 0 a cos ]] }
/RH { /a exch def
[[1 0 0 ]
[0 a cos a sin neg]
[0 a sin a cos ]] }
/F { State /P 2 copy get
State /V get 0 get %pos H^
[R R R] {mul} vop {add} vop %pos+R*H^
dup
aload pop project
pen? {lineto
currentpoint stroke moveto
/flushpage where {pop flushpage} if
}{moveto} ifelse
put
}
/renormalize {
0 1 2 {
State /V get exch 2 copy get
dup mag [ exch dup dup ] {div} vop
put
} for
}
/rot {
{
%pstack
exch %transpose exch % H L U as column vectors
matmul
%transpose %and flip 'em back to make H easy to crack in /F
exit
[ 3 1 roll % [ V R
exch { % [ .. R Vi
%1 array astore transpose
1 index matmul % [ .. R Vi*R
transpose 0 get
exch % [ .. Vi*R R
} forall
pop ]
%dup ==()=
exit } loop
}
/fixup {}%{ renormalize }
/+ { State /V 2 copy get T RU rot put fixup } % turn left
/- { State /V 2 copy get T neg RU rot put fixup } % turn right
/& { State /V 2 copy get T RL rot put fixup } % pitch down
/^ { State /V 2 copy get T neg RL rot put fixup } % pitch up
/, { State /V 2 copy get T RH rot put fixup } % roll left
/. { State /V 2 copy get T neg RH rot put fixup } % roll left
/| { State /V 2 copy get 180 RU rot put fixup } % about face
>> def
/DOL {
[ exch {
dup type /arraytype eq {
DOL
dup type /arraytype eq {
}{
currentdict exch 2 copy known {
get %aload pop
currentdict exch 2 copy known {
}{
exch pop
} ifelse
} ifelse
} forall ] cvx
} def
/Dexec {
{
dup type /arraytype eq {
Dexec
}{
exec
} ifelse
} forall
Turtle begin
<<
/R 20 % "radius" of movement
/T 90 % rotation angle
/pen? true
>> begin
<<
/A { B - F + C F C + F - D & F ^ D - F + & & C F C + F + B . . }
/B { A & F ^ C F B ^ F ^ D ^ ^ - F - D ^ | F ^ B | F C ^ F ^ A . . }
/C { | D ^ | F ^ B - F + C ^ F ^ A & & F A & F ^ C + F + B ^ F ^ D . . }
/D { | C F B - F + B | F A & F ^ A & & F B - F + B | F C . . }
>> begin
<< %T=45
/A { B B B B }
/B { F + C + }
/C { - & A ^ + }
>> pop%begin
<< %T=45
/A { F B - - F B - - F B - - F B - - C }
/B { + . . + A - , , - }
>> pop%begin
<< %T=90
/A { F B }
/B { . & A & A & A & A , }
>> pop%begin
/n 1 def
{
(n =)print n =
50 700 translate
0 0 moveto
1 2 dup dup scale div .8 mul setlinewidth
%2 setlinewidth
%.5 setlinewidth
0 .6 .8 sethsbcolor
%F + F & F - F
%4 { .
% 4 { F + } repeat
%} repeat
%exit}loop currentfile flushfile
{ A } n { DOL } repeat
<< /A {} /B {} /D {}
%/C {}
/C { currenthsbcolor 3 2 roll .1 add dup 1 gt { pop 0 } if 3 1 roll sethsbcolor }
>> begin
Dexec
end
showpage
/n n 1 add def
} loop
0 new messages