(C) Roger Whittaker 2015
roger@disruptive.org.uk
Free software licenced under the GPL

> module Postscript (processps)

> where

> import Penrose
> import Data.String.Utils
> import Utils

> c = coordinates

> pslines :: [Char] -> [Char]
> pslines y = "newpath\n"
>             ++ (split "," ((c y)!!0))!!0 ++ " "
>             ++ (split "," ((c y)!!0))!!1 ++ " m\n"
>             ++ (split "," ((c y)!!1))!!0 ++ " "
>             ++ (split "," ((c y)!!1))!!1 ++ " l\n"
>             ++ (split "," ((c y)!!2))!!0 ++ " "
>             ++ (split "," ((c y)!!2))!!1 ++ " l\n"
>             ++ (split "," ((c y)!!3))!!0 ++ " "
>             ++ (split "," ((c y)!!3))!!1 ++ " l\n"
>             ++ (split "," ((c y)!!0))!!0 ++ " "
>             ++ (split "," ((c y)!!0))!!1 ++ " l\n"
>             ++ "gsave" ++ "\n"

--> cut these lines for no fill

>             ++ "c" ++ kind y ++ "\n"
>             ++ "fill" ++ "\n"
>             ++ "grestore" ++ "\n"
>             ++ "0 0 0 setrgbcolor" ++ "\n"

--> /cut

>             ++ "0.001 setlinewidth" ++ "\n"
>             ++ "stroke" ++ "\n\n"

colours from Svg.lhs

col "0" = "blue"
col "1" = "yellow"
col "2" = "green"
col "3" = "pink"
col "4" = "orange"
col "5" = "purple"
col "6" = "slateblue"
col "7" = "fushia"
col "8" = "cyan"
col "9" = "palegreen"
col "10" = "salmon"
col "11" = "gold"
col "12" = "navy"
col "13" = "maroon"
col "14" = "mediumpurple"
col  _  = "none"

reference for colours:
http://www.on-the-matrix.com/webtools/HtmlColorCodes.aspx#NamedColors


> psheader :: [[Char]] -> [[Char]]
> psheader y = ["%!"
>              ,"310 400 translate"
>              ,"/l {lineto} def"
>              ,"/m {moveto} def"
>              ,"/c0  {0.00 0.00 1.00 setrgbcolor} def" -- blue
>              ,"/c1  {1.00 1.00 0.00 setrgbcolor} def" -- yellow
>              ,"/c2  {0.00 1.00 0.00 setrgbcolor} def" -- green
>              ,"/c3  {1.00 0.00 1.00 setrgbcolor} def" -- magenta
>              ,"/c4  {1.00 0.00 0.00 setrgbcolor} def" -- red
>              ,"/c5  {0.00 1.00 1.00 setrgbcolor} def" -- aqua

>              ,"/c6  {0.00 0.00 0.40 setrgbcolor} def"
>              ,"/c7  {0.40 0.40 0.00 setrgbcolor} def"
>              ,"/c8  {0.00 0.40 0.00 setrgbcolor} def"
>              ,"/c9  {0.40 0.00 0.40 setrgbcolor} def"
>              ,"/c10 {0.40 0.00 0.00 setrgbcolor} def"
>              ,"/c11 {0.00 0.40 0.40 setrgbcolor} def"

>              ,"/c12 {0.60 0.60 1.00 setrgbcolor} def"
>              ,"/c13 {1.00 1.00 0.60 setrgbcolor} def"
>              ,"/c14 {0.60 1.00 0.60 setrgbcolor} def"
>              ,"/c15 {1.00 0.60 1.00 setrgbcolor} def"
>              ,"/c16 {1.00 0.60 0.60 setrgbcolor} def"
>              ,"/c17 {0.60 1.00 1.00 setrgbcolor} def"

>              ,"10 10 scale"
>              ,"0.01 setlinewidth\n"
>              ,""
>              ,"/Times-Roman findfont"
>              ,"1.2 scalefont"
>              ,"setfont"
>              ,"newpath"
>              ,"-25 -32 moveto"
>              ,"(" ++ format y!!0 ++ ") show"
>              ,""
>              ,"/Times-Roman findfont"
>              ,"1.2 scalefont"
>              ,"setfont"
>              ,"newpath"
>              ,"-25 -34 moveto"
>              ,"(" ++ format y!!1 ++ ") show"
>              ,""
>              ,"/Times-Roman findfont"
>              ,"0.5 scalefont"
>              ,"setfont"
>              ,"newpath"
>              ,"-25 -36 moveto"
>              ,"(" ++ genby "gppg" y ++ ") show"
>              ,""
>              ,"newpath"
>              ,"-25 -30 m"
>              ,"-25  30 l"
>              ,"25   30 l"
>              ,"25  -30 l"
>              ,"-25 -30 l"
>              ,"stroke"
>              ,""
>              ,"newpath"
>              ,"-25 -30 m"
>              ,"-25  30 l"
>              ,"25   30 l"
>              ,"25  -30 l"
>              ,"-25 -30 l"
>              ,"clip"
>              ,""
>              ]

> psfooter :: [[Char]]
> psfooter = ["",
>             "",
>             "showpage",
>             ""]

> tops :: ([[Char]], [[Char]]) -> [Char]
> tops x = unlines (psheader (fst x)) ++ unlines (map pslines (snd x)) ++ unlines psfooter


> processps :: ([[Char]], [[Char]]) -> [Char]
> processps = tops