Path: csiph.com!newsfeed.xs4all.nl!newsfeed8.news.xs4all.nl!feeder1.feed.usenet.farm!feed.usenet.farm!aioe.org!P703Hxu1m1uplaQVJzdzug.user.46.165.242.75.POSTED!not-for-mail
From: news@zzo38computer.org.invalid
Newsgroups: comp.lang.postscript
Subject: ZZT World Map
Date: Thu, 14 Oct 2021 22:34:49 -0700
Organization: Aioe.org NNTP Server
Message-ID: <1634274249.bystand@zzo38computer.org>
Mime-Version: 1.0
Injection-Info: gioia.aioe.org; logging-data="40440"; posting-host="P703Hxu1m1uplaQVJzdzug.user.gioia.aioe.org"; mail-complaints-to="abuse@aioe.org";
User-Agent: bystand/1.3.0pre
X-Notice: Filtered by postfilter v. 0.9.2
Xref: csiph.com comp.lang.postscript:3686

I made a PostScript program to make a ZZT world map; the code is below.
However, sometimes it doesn't work because it doesn't fit on the page, or
because rooms will overlap, or lines will cross, etc. It might also be
wanted to include rooms reachable by passages. How can it be fixed
to properly position everything and bend the lines if needed? Other
improvements could also be made, such as additional options (for page
orientation, margins, page titles, font size, etc), etc.

The below code can also be found in the "FreeZZT" project, which also
includes the zzt.ps file, too. The FreeZZT project is available at:
  http://chiselapp.com/user/zzo38/repository/FreeZZT/dir?ci=tip&name=ps

The below code and this entire message is in the public domain.

===begin PostScript code===
(zzt.ps) run

/W ARGUMENTS 0 get (r) file zzt.loadworld def
/B W /Boards get def
/M << 0 null >> def

/Find {  %( x y board -- )
  M 1 index known not {
    M 1 index [5 index 5 index] put
    B exch get
    2 index 1 sub 2 index 2 index /West get Find
    2 index 1 add 2 index 2 index /East get Find
    2 index 2 index 1 add 2 index /North get Find
    2 index 2 index 1 sub 2 index /South get Find
  } if
  pop pop pop
} bind def

0 0 ARGUMENTS length 1 gt {ARGUMENTS 1 get cvi} {W /StartBoard get} ifelse Find
M 0 undef

currentpagedevice /PageSize get cvx exec
2 copy lt {exch [3 copy pop] << exch /PageSize exch >> setpagedevice} if
/Ysize exch def
/Xsize exch def

/_Font /Courier findfont << >> copy
  dup /Encoding /PCEncoding /Encoding findresource put
definefont pop

/_Font 9 selectfont
2 setlinewidth

/Xmin 0 M {exch pop 0 get min} forall def
/Xmax 0 M {exch pop 0 get max} forall def
/Ymin 0 M {exch pop 1 get min} forall def
/Ymax 0 M {exch pop 1 get max} forall def

% Set centre point according to map extents

/Ymid Ysize 2 div Ymax Ymin add 31 mul sub def
/Xmid Xsize 2 div Xmax Xmin add 38 mul sub def

% Drawing the lines between rooms

/Way {  %( ox oy odir dir x y -- )
  gsave
  rmoveto
  C exch get
  dup 0 ne {
    M 1 index get
    Xmid 1 index 0 get 76 mul add 6 -1 roll add
    exch 1 get Ymid exch 62 mul add 5 -1 roll add
    lineto
    B exch get exch get N eq {{}} {{2 3}} ifelse 0 setdash stroke
  } {
    pop pop pop pop
  } ifelse
  grestore
} bind def

M {
  newpath
  Xmid 1 index 0 get 76 mul add
  exch Ymid exch 1 get 62 mul add
  moveto
  /N exch def
  /C B N get def
  0 -24 /South /North 0 24 Way
  0 24 /North /South 0 -24 Way
  -24 0 /West /East 24 0 Way
  24 0 /East /West -24 0 Way
} bind forall

% Drawing the rooms

/SpWidth ( ) stringwidth pop def
/AddWidth {N 0 ne {SpWidth add} if N add} bind def

/Line {  %( mark ... width -- mark )
  gsave -2 div 0 rmoveto
  ] {show /space glyphshow} forall mark
  grestore 0 -10 rmoveto
} bind def

[] 0 setdash
M {
  newpath
  Xmid 1 index 0 get 76 mul add
  exch Ymid exch 1 get 62 mul add
  moveto
  gsave
    currentpoint exch 32 sub exch 24 sub 64 48
    gsave .88 setgray 4 copy rectfill grestore rectstroke
  grestore
  B exch get /Name get
  /N 0 def
  [exch {
    ( ) search {
      exch pop  % discard the space
      dup stringwidth pop
      dup AddWidth 62 ge {
        N exch /N exch def /Line cvx 4 2 roll exch
      } {
        AddWidth /N exch def exch
      } ifelse
    } {
      dup stringwidth pop
      dup AddWidth 62 ge {
        N /Line cvx 4 2 roll /Line cvx
      } {
        AddWidth /Line cvx
      } ifelse
      exit
    } ifelse
  } loop] cvx
  -7.5 1 index {/Line eq {5 add} if} forall
  0 exch rmoveto
  mark exch exec pop
} bind forall

showpage
quit
===end PostScript code===

-- 
Don't laugh at the moon when it is day time in France.