%
%  Experimental PostScript Map Printer
%
%  This generates a postscript map from the current game data. You can
%  then print that map on a normal PostScript printer. The PS output is
%  almost readable so you can adjust it if you wish.
%
%  Usage: call `ps.Print'. This will ask you for an extent and a file
%  name. It will print the requested region around the current position
%  in the map/control screen. To print the whole map, go to the map
%  center and use the Extent you also configured in the chart options.
%
%  13/Oct/2002 by Stefan Reuther
%

% Print a map around current X/Y
Sub ps.Print
  Local UI.Result, extent, file, fd
  UI.Input "Extent of printed map:", "PostScript Map", 5, "n", "200"
  extent := Val(UI.Result)
  If IsEmpty(extent) Then Return
  UI.FileWindow "PostScript Map", "*.ps"
  file := UI.Result
  If IsEmpty(file) Then Return

  fd := FreeFile()
  Open file For Output As #fd
  ps.PrintMap UI.X, UI.Y, extent, fd
  Close #fd
EndSub

Sub ps.PrintMap (x, y, extent, fd)
  Print "Printing map..."
  Print #fd, "%! Map Printed by PSMap.q"
  Print #fd, ""
  Print #fd, "% Center coordinates of Map
  Print #fd, "/CenterX ", x, " def"
  Print #fd, "/CenterY ", y, " def"
  Print #fd, "/Extent ", extent, " def"
  Print #fd, ""
  Print #fd, "% compute scale factor"
  Print #fd, "clippath pathbbox         % x1 y1 x2 y2"
  Print #fd, "/MaxY exch def /MaxX exch def /MinY exch def /MinX exch def"
  Print #fd, "MaxX MinX sub MaxY MinY sub min Extent 2 mul div"
  Print #fd, "/Factor exch def"
  Print #fd, "/MinWX CenterX Extent sub def"
  Print #fd, "/MinWY CenterY Extent sub def"
  Print #fd, ""
  Print #fd, "% coordinate transformations etc.
  Print #fd, "/SX { MinWX sub Factor mul MinX add } def"
  Print #fd, "/SY { MinWY sub Factor mul MinY add } def"
  Print #fd, "/SR { Factor mul 1 max } def"
  Print #fd, "/SXY { exch SX exch SY } def"
  Print #fd, "/CR 6 SR def"
  Print #fd, "0.25 setlinewidth"
  Print #fd, ""
  Print #fd, "% x y xrad yrad starth endh ->"
  Print #fd, "/DrawEllipse {"
  Print #fd, "  newpath"
  Print #fd, "  /endangle exch def /startangle exch def"
  Print #fd, "  /yrad exch def /xrad exch def /y exch def /x exch def"
  Print #fd, "  /savematrix matrix currentmatrix def x y translate xrad"
  Print #fd, "  yrad scale 0 0 1 startangle endangle arc savematrix setmatrix"
  Print #fd, "} def"
  Print #fd, "/DrawCircle { dup 0 360 DrawEllipse } def"
  Print #fd, "/Pixel { 0.25 0.25 0 360 DrawEllipse stroke } def"
  Print #fd, ""
  Print #fd, "/DottedLine { [1 1] 0 setdash newpath moveto lineto stroke [] 0 setdash } def"
  Print #fd, "/Times-Roman findfont 4 scalefont setfont"
  Print #fd, "/ShowCentered { dup stringwidth pop -0.5 mul -4 rmoveto show } def"
  Print #fd, ""

  ps.Sectors fd
  ps.Mines fd
  ps.Ufos fd
  ps.Ions fd
  ps.Drawings fd
  ps.Planets fd
  ps.Ships fd

  Print #fd, "showpage"
EndSub

Sub ps.Sectors (fd)
  Local i
  For i:=10 To 30 Do Print #fd, 100*i, " SX 1000 SY ", 100*i, " SX 3000 SY DottedLine"
  For i:=10 To 30 Do Print #fd, "1000 SX ", 100*i, " SY 3000 SX ", 100*i, " SY DottedLine"
EndSub

Sub ps.Mines (fd)
  Print #fd, "% Mines"
  ForEach Minefield Do
    Print #fd, Loc.X, " ", Loc.Y, " SXY ", Radius, " SR DrawCircle stroke"
  Next
EndSub

Sub ps.Ufos (fd)
EndSub

Sub ps.Ions (fd)
EndSub

Sub ps.Drawings (fd)
EndSub

Sub ps.Planets (fd)
  Local dy
  ForEach Planet Do
    Print #fd, Loc.X, " ", Loc.Y, " SXY Pixel"
    If Owner$ Then
      Print #fd, Loc.X, " ", Loc.Y, " SXY 3 SR DrawCircle stroke"
      dy := 4
    Else
      Print #fd, Loc.X, " ", Loc.Y, " SXY 2 SR DrawCircle stroke"
      dy := 3
    EndIf
    If Orbit Then
      Print #fd, Loc.X, " ", Loc.Y, " SXY 4 SR DrawCircle stroke"
      dy := 5
    EndIf
    If Base.YesNo Then
      Print #fd, Loc.X, " ", Loc.Y, " SXY moveto"
      Print #fd, "CR neg 0 rmoveto CR 2 mul 0 rlineto stroke"
      Print #fd, Loc.X, " ", Loc.Y, " SXY moveto"
      Print #fd, "0 CR neg rmoveto 0 CR 2 mul rlineto stroke"
    EndIf
    Print #fd, Loc.X, " ", Loc.Y, " SXY moveto (p", id, ") ShowCentered"
  Next
EndSub

Sub ps.Ships (fd)
  ForEach Ship Do
    Print #fd, Loc.X, " ", Loc.Y, " SXY Pixel"
  Next
EndSub

If My.Race And Not System.GUI Then ps.Print