I'm a blackstar

23 views
Skip to first unread message

luser droog

unread,
Jan 2, 2022, 12:58:25 AMJan 2
to

<<
/ps { (stack:)= pstack }
/poly { % m
[
0 360 4 -1 roll div 360.0 {
1 0 3 2 roll matrix rotate transform
} for
] 0 1 index length 2 sub getinterval
}
/star { % m n
exch poly exch
[ 3 1 roll
0 { % [ ... [] n i
3 copy exch pop 2 getinterval aload pop % [ ... [] n i []_i
5 2 roll % [ ... []_i [] n i
1 index 2 mul add 2 index length mod % [ ... [] n i+n%#
dup 0 eq { pop pop pop exit } if
} loop
]
}
/fortuple { 1 dict begin {p n a}{exch def}forall
0 n /a load length 1 sub
[ /a load /exch cvx n /getinterval cvx /p load /exec cvx ] cvx
end for
}
/draw {
dup 0 2 getinterval aload pop moveto
2 1 index length 2 sub getinterval
2 {
aload pop lineto
} fortuple
closepath
}
>> begin

2 poly ==
3 poly ==
5 poly ==
5 2 star ==
7 3 star ==
3 1 star ==
300 400 translate 100 dup scale
5 2 star dup == draw stroke
showpage
quit


Output:
$ gs star.ps
GPL Ghostscript 9.52 (2020-03-19)
Copyright (C) 2020 Artifex Software, Inc. All rights reserved.
This software is supplied under the GNU AGPLv3 and comes with NO WARRANTY:
see the file COPYING for details.
[1.0 0.0 -1.0 0.0]
[1.0 0.0 -0.5 0.866025388 -0.5 -0.866025388]
[1.0 0.0 0.309017 0.95105654 -0.809017 0.587785244 -0.809017 -0.587785244 0.309017 -0.95105654]
[1.0 0.0 -0.809017 0.587785244 0.309017 -0.95105654 0.309017 0.95105654 -0.809017 -0.587785244]
[1.0 0.0 -0.90096879 0.433883876 0.623489559 -0.781831682 -0.222520873 0.974927902 -0.222521 -0.974927902 0.623489797 0.781831443 -0.900968909 -0.433883637]
[1.0 0.0 -0.5 0.866025388 -0.5 -0.866025388]
[1.0 0.0 -0.809017 0.587785244 0.309017 -0.95105654 0.309017 0.95105654 -0.809017 -0.587785244]
>>showpage, press <return> to continue<<

luser droog

unread,
Jan 4, 2022, 5:55:57 PMJan 4
to
A little sup-ed up with assistance from a pdf by Kees var der Laan.

%!
<<
/ps { (stack:)= pstack }
/poly { % m
[
0 360 4 -1 roll div 360.0 {
1 0 3 2 roll matrix rotate transform 2 array astore
} for
] 0 1 index length 1 sub getinterval
}
/cycle { % m n
[ 3 1 roll
0 { % [ ... m n i
dup 4 1 roll % [ ... i m n i
1 index add 2 index mod % [ ... i m n i+n
dup 0 eq { pop pop pop exit } if
} loop
]
}
/first { 0 get }
/rest { 1 1 index length 1 sub getinterval }
/map { 1 index xcheck 3 1 roll [ 3 1 roll forall ] exch {cvx} if }
/curry { dup xcheck 3 1 roll
dup length 1 add array dup 0 5 -1 roll put dup 1 4 -1 roll putinterval
exch {cvx} if }
/fx,mapgxs { % a f g
3 1 roll exch dup first % g f a a0
3 -1 roll [ 3 1 roll exec ] % g a [a0 f]
3 1 roll rest exch map % [a0 f] [a1..N g]
}
/select { % array indices
exch { % i a
exch get
} curry
map
}
/unroll-star { % m n
1 index poly 3 1 roll % poly m n
0 exch dup 1 exch % poly m 0 n 1 n
1 exch sub 4 index add 4 index mod % poly m 0 n 1 1-n%m
4 array astore exch 3 1 roll select % m [a c b d]
intersect % m x y
[0 0] distance
ps
1 exch star2
}
/star2 { 1 dict begin {r2 r1 m}{exch def}forall
/alfa 360 m div def
/alfa2 alfa 2 div def
[
0 alfa 360.0 {
dup r1 0 3 2 roll matrix rotate transform 2 array astore exch
r2 0 3 2 roll alfa2 add matrix rotate transform 2 array astore
} for
] 0 1 index length 1 sub getinterval
end }
% intersect adapted from https://www.ntg.nl/maps/18/23.pdf
/intersect { aload pop
1 dict begin {d c b a}{exch def}forall
1 1
1 1 [a _x b _x a _y b _y 0 0] itransform % A B
1 1 [c _x d _x c _y d _y 0 0] itransform % A B C D
0 0 6 array astore
itransform 2 array astore
end }
/_x { 0 get }
/_y { 1 get }
/distance { % [x1 y1] [x2 y2]
exch aload pop 3 2 roll aload pop
exch 4 1 roll exch sub dup mul % x2 x1 (y2-y1)^2
3 1 roll sub dup mul add sqrt
}
/star { % m n
1 index poly 3 1 roll cycle select
}
/draw {
{aload pop moveto} {aload pop lineto} fx,mapgxs pop pop
closepath
}
>> begin

2 poly ==
3 poly ==
5 poly ==
5 2 star ==
7 3 star ==
3 1 star ==
300 400 translate
currentlinewidth
3 72 mul dup dup scale
div setlinewidth
5 2 star draw fill
1.125 dup scale
5 2 unroll-star draw stroke
showpage
quit


Output:
$ gs star.ps
GPL Ghostscript 9.52 (2020-03-19)
Copyright (C) 2020 Artifex Software, Inc. All rights reserved.
This software is supplied under the GNU AGPLv3 and comes with NO WARRANTY:
see the file COPYING for details.
[[1.0 0.0] [-1.0 0.0]]
[[1.0 0.0] [-0.5 0.866025388] [-0.5 -0.866025388]]
[[1.0 0.0] [0.309017 0.95105654] [-0.809017 0.587785244] [-0.809017 -0.587785244] [0.309017 -0.95105654]]
[[1.0 0.0] [-0.809017 0.587785244] [0.309017 -0.95105654] [0.309017 0.95105654] [-0.809017 -0.587785244]]
[[1.0 0.0] [-0.90096879 0.433883876] [0.623489559 -0.781831682] [-0.222520873 0.974927902] [-0.222521 -0.974927902] [0.623489797 0.781831443] [-0.900968909 -0.433883637]]
[[1.0 0.0] [-0.5 0.866025388] [-0.5 -0.866025388]]
stack:
0.386123687
5
Reply all
Reply to author
Forward
0 new messages