Comment detail
必ず解ける迷路 (Nested Flatten)だいぶ動作速度を改善しました。 diff にしようかと思いましたが、あまり小さくならないので、そのままつっこみます。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 | %!PS
/GenOneLine { % width v firstline_p GenOneLine width v 3
gsave
0
3 index
{
2 copy sub
rand exch mod add
2 index exch get aload pop 0 0 moveto rlineto
1 0 translate
} repeat
pop pop 3
stroke
grestore
} bind def
/GenMaze { % NumRoadX NumRoadY MazeWidth MazeHeight OffsetX OffsetY WallWidth
gsave
% --- Set graphics parameters ---
dup -1 eq {
pop
0.5
} {
6 index mul 4 index div
} ifelse
setlinewidth
translate
2 index div
exch 3 index div exch
scale
0 setgray
2 setlinecap
true setstrokeadjust
% --- draw outline box ---
0 0 moveto 1 index 0 lineto 2 copy lineto 0 1 index lineto closepath stroke
1 1 translate
exch 1 sub exch 2 sub
[[0 -1 0] [0 0 1] [1 1 0] [0 0 -1]]
3 -1 roll exch 4
% Y X v 4
GenOneLine
% Y X v 3
4 -1 roll
{
% X v 3
0 1 translate
GenOneLine
} repeat
pop pop pop
grestore
} bind def
% ========== Test Code ==========
/cm { 72 mul 2.54 div } bind def
/mm { 72 mul 25.4 div } bind def
/Arial-Black findfont 16 scalefont setfont
realtime dup srand
% size, drawing area, offset, pen width
% 10 10 15 cm 15 cm 1 cm 3 cm 5 mm GenMaze
<< /PageSize [ 102 cm 110 cm ] >> setpagedevice
% size, drawing area, offset, pen width
1024 1024 100 cm 100 cm 1 cm 3 cm 0.3 mm GenMaze
10 mm 10 mm moveto (Timer = ) show
realtime exch sub 1000 div 10 string cvs show ( sec) show
showpage
|




Nemo
#5983()
[
PostScript
]
Rating0/0=0.00
%!PS /GenOneLine { % firstline_p width GenOneLine - gsave 1 sub 0 [[-1 0] [0 1] [1 0] [0 -1]] 3 -1 roll { dup rand 3 5 index add 4 index sub mod 4 -1 roll add dup 2 eq { 1 } { 0 } ifelse 4 1 roll get aload pop 0 0 moveto rlineto stroke 1 0 translate } repeat pop pop pop grestore } bind def /GenMaze { % NumRoadX NumRoadY MazeWidth MazeHeight OffsetX OffsetY WallWidth gsave dup -1 eq { pop 0.5 } { 6 index mul 4 index div } ifelse setlinewidth translate 2 index div exch 3 index div exch scale 0 setgray 2 setlinecap true setstrokeadjust 0 0 moveto 1 index 0 lineto 2 copy lineto 0 1 index lineto closepath stroke 1 1 translate 1 2 index GenOneLine 2 sub { 0 1 translate dup 0 exch GenOneLine } repeat pop grestore } bind def % ========== Test Code ========== /cm { 72 mul 2.54 div } bind def /mm { 72 mul 25.4 div } bind def /Arial-Black findfont 16 scalefont setfont realtime dup srand % size, drawing area, offset, pen width % 5 5 15 cm 15 cm 1 cm 1 cm 10 mm GenMaze 1024 1024 15 cm 15 cm 1 cm 1 cm 0 GenMaze 10 10 moveto (Timer = ) show realtime exch sub 1000 div 10 string cvs show ( sec) show showpageRating0/0=0.00-0+
1 reply [ reply ]