module Layout.Postscript where
import Data.Hardware.Internal
import Layout.Floorplan
type Color = (Float, Float, Float)
black, white, grey, red, green, blue :: Color
black = (0,0,0)
white = (1,1,1)
grey = (0.5,0.5,0.5)
red = (1,0,0)
green = (0,1,0)
blue = (0,0,1)
type Postscript = ShowS
class Show a => PSShow a
where
psShow :: a -> Postscript
instance PSShow Length
where
psShow = shows . unLength
instance PSShow String
where
psShow a = "(" .+ showString a .+ ")"
instance PSShow Orientation
where
psShow (flipped,dir) = shows (f + d)
where
f = if flipped then 4 else 0
d = case dir of
Rightwards -> 3
Leftwards -> 1
Upwards -> 0
Downwards -> 2
absToPS :: AbsFloorplan s b -> Postscript
absToPS [] = ""
absToPS (pos_bl : pos_bls) = absPS pos_bl .+ absToPS pos_bls
where
absPS (pos, Box sz ori nm _) = blockLine pos sz ori nm
absPS _ = id
blockLine (x,y) (w,h) ori nm
| min w h > Length 0 = unwordS
[ psShow x
, psShow y
, psShow w
, psShow h
, psShow ori
, psShow nm
, "block\n"
]
| otherwise = ""
floorplanToPS :: Floorplan s b -> (Postscript, Size)
floorplanToPS fp = (absToPS afp, sz)
where
(afp,sz) = absolutize fp
linesToPS :: [([(Position,Position)], Color)] -> Postscript
linesToPS lcs = unlineS [toPS col lines | (lines,col) <- lcs]
where
toPS _ [] = ""
toPS col@(r,g,b) (line:lines)
= unwordS
[ psShow x1, psShow y1
, psShow x2, psShow y2
, "{" .+ unwordS (map shows [r,g,b]) .+ "}"
, "wire\n"
]
.+ toPS col lines
where
((x1,y1),(x2,y2)) = line
renderFloorplan_
:: Length
-> Name
-> Floorplan s b
-> [([(Position,Position)], Color)]
-> IO ()
renderFloorplan_ lnScale title fp lines = writeFile (title ++ ".ps")
$ "%!PS-Adobe-1.0\n"
.+ "%%Title: " .+ showString title .+ "\n"
.+ ps1
.+ lnScLine
.+ ps2
.+ setPicSize sz
.+ ps3
.+ ps
.+ "\nwireWidth setlinewidth\n\n"
.+ linesToPS lines
$ "showpage\n"
where
(ps,sz) = floorplanToPS fp
lnScLine
= lnsc
.+ showString (replicate (6 length (lnsc "")) ' ')
.+ "% Scale for lines and names\n"
where
lnsc = psShow lnScale
setPicSize (x,y) = unlineS
[ "/picW " .+ psShow x .+ " def"
, "/picH " .+ psShow y .+ " def"
, " % Width/heigth of picture (in floorplan units)"
, ""
]
renderFloorplan :: Name -> Floorplan s b -> IO ()
renderFloorplan title fp = renderFloorplan_ (Length 1) title fp []
ps1 :: Postscript
ps1 =
"%%DocumentFonts: Helvetica \n\
\%%BoundingBox: 0 0 595 842 \n\
\%%EndComments \n\
\ \n\
\% The picture is scaled to fit on an A4 paper (see bounding box above). \n\
\% In order to zoom in on a particular area, just adjust the bounding box \n\
\% and/or the scale. \n\
\ \n\
\ \n\
\ \n\
\%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \n\
\%%% Setup \n\
\%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \n\
\ \n\
\true % Print block names? \n\
\2 % Vertical margin in [mm] \n\
\2 % Horizontal margin in [mm] \n\
\15 % Height of block names (~floorplan units) \n\
\2 % Width of wire lines (in floorplan units) \n\
\2.5 % Radius of box corners (in floorplan units) \n\
\2.5 % Line width of primitive blocks (in floorplan units) \n\
\1 % Overall scale \n"
ps2 :: Postscript
ps2 =
" \n\
\%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \n\
\/lnSc exch def %% \n\
\/sc exch def %% \n\
\/boxLineWidth exch lnSc mul def %% \n\
\/boxCornerRad exch lnSc mul def %% \n\
\/wireWidth exch lnSc mul def %% \n\
\/namesFontSize exch lnSc mul def %% \n\
\/margH exch def %% \n\
\/margV exch def %% \n\
\/prNames exch def %% \n\
\%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \n\
\ % Bindings in reversed order \n\
\ \n\
\/ratio {72 25.4 div} def \n\
\ % Units/mm \n\
\ \n\
\/totW 210 def \n\
\/totH 297 def \n\
\ % Width/height of A4 in [mm] \n\
\ \n\
\/totWU {totW ratio mul} def \n\
\/totHU {totH ratio mul} def \n\
\ % Unit width/height of A4 \n\
\ \n\
\/margHU {margH ratio mul} def \n\
\/margVU {margV ratio mul} def \n\
\ % Horizontal/vertical margin units \n\
\ \n\
\/picWU {totWU margHU 2 mul sub} def \n\
\/picHU {totHU margVU 2 mul sub} def \n\
\ % Unit width/height of the picture \n\
\ \n"
ps3 :: Postscript
ps3 =
"/scH {picWU picW div} def \n\
\/scV {picHU picH div} def \n\
\scH scV gt {/scHV scV def} {/scHV scH def} ifelse \n\
\ % Scale necessary to fit picture in the page \n\
\ \n\
\margHU margVU translate \n\
\ \n\
\sc scHV mul dup scale \n\
\ \n\
\/Helvetica findfont \n\
\namesFontSize scalefont \n\
\setfont \n\
\ \n\
\ \n\
\ \n\
\%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \n\
\%%% Helper functions \n\
\%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \n\
\ \n\
\/rectWH { \n\
\ 2 dict begin \n\
\ /h exch def \n\
\ /w exch def \n\
\ w 0 rlineto \n\
\ 0 h rlineto \n\
\ w neg 0 rlineto \n\
\ closepath \n\
\ end \n\
\} def \n\
\ \n\
\/rectWH_round { \n\
\ 10 dict begin \n\
\ /r exch def \n\
\ /h exch def \n\
\ /w exch def \n\
\ \n\
\ h boxCornerRad 2 mul lt \n\
\ w boxCornerRad 2 mul lt or \n\
\ {w h rectWH} \n\
\ { /wr {w r sub r sub} def \n\
\ /hr {h r sub r sub} def \n\
\ /r2 {r 2 div} def \n\
\ /rn {r neg} def \n\
\ /r2n {r2 neg} def \n\
\ \n\
\ currentpoint \n\
\ /y exch def \n\
\ /x exch def \n\
\ newpath \n\
\ x r add y moveto \n\
\ % Start new path since we cannot start from the lower left corner \n\
\ \n\
\ wr 0 rlineto \n\
\ r2 0 r r2 r r rcurveto \n\
\ 0 hr rlineto \n\
\ 0 r2 r2n r rn r rcurveto \n\
\ wr neg 0 rlineto \n\
\ r2n 0 rn r2n rn rn rcurveto \n\
\ 0 hr neg rlineto \n\
\ 0 r2n r2 rn r rn rcurveto \n\
\ closepath \n\
\ } ifelse \n\
\ \n\
\ end \n\
\} def \n\
\ \n\
\/block { \n\
\ 9 dict begin \n\
\ /name exch def % Block name \n\
\ /ori exch def % Orientation (0=N,1=W,2=S,3=E,4=FN,5=FW,6=FS,7=FE) \n\
\ /h exch def % Height \n\
\ /w exch def % Width \n\
\ /py exch def % Y position \n\
\ /px exch def % X position \n\
\ \n\
\ /c1 0.4 def \n\
\ /c2 8 def \n\
\ /c3 6 def \n\
\ % Constants for the orientation triangle \n\
\ \n\
\ gsave \n\
\ px py translate \n\
\ \n\
\ newpath \n\
\ 0 0 moveto \n\
\ w h boxCornerRad rectWH_round \n\
\ \n\
\ gsave \n\
\ 0.75 setgray \n\
\ fill \n\
\ grestore \n\
\ \n\
\ gsave \n\
\ newpath \n\
\ \n\
\ ori 0 eq \n\
\ { boxLineWidth c1 mul dup moveto \n\
\ boxLineWidth c2 mul 0 rlineto \n\
\ boxLineWidth c3 neg mul boxLineWidth c2 mul rlineto \n\
\ } if \n\
\ \n\
\ ori 1 eq \n\
\ { w 0 moveto \n\
\ boxLineWidth c1 neg mul boxLineWidth c1 mul rmoveto \n\
\ 0 boxLineWidth c2 mul rlineto \n\
\ boxLineWidth c2 neg mul boxLineWidth c3 neg mul rlineto \n\
\ } if \n\
\ \n\
\ ori 2 eq \n\
\ { w h moveto \n\
\ boxLineWidth c1 neg mul dup rmoveto \n\
\ boxLineWidth c2 neg mul 0 rlineto \n\
\ boxLineWidth c3 mul boxLineWidth c2 neg mul rlineto \n\
\ } if \n\
\ \n\
\ ori 3 eq \n\
\ { 0 h moveto \n\
\ boxLineWidth c1 mul boxLineWidth c1 neg mul rmoveto \n\
\ 0 boxLineWidth c2 neg mul rlineto \n\
\ boxLineWidth c2 mul boxLineWidth c3 mul rlineto \n\
\ } if \n\
\ \n\
\ ori 4 eq \n\
\ { w 0 moveto \n\
\ boxLineWidth c1 neg mul boxLineWidth c1 mul rmoveto \n\
\ boxLineWidth c2 neg mul 0 rlineto \n\
\ boxLineWidth c3 mul boxLineWidth c2 mul rlineto \n\
\ } if \n\
\ \n\
\ ori 5 eq \n\
\ { boxLineWidth c1 mul dup moveto \n\
\ 0 boxLineWidth c2 mul rlineto \n\
\ boxLineWidth c2 mul boxLineWidth c3 neg mul rlineto \n\
\ } if \n\
\ \n\
\ ori 6 eq \n\
\ { 0 h moveto \n\
\ boxLineWidth c1 mul boxLineWidth c1 neg mul rmoveto \n\
\ boxLineWidth c2 mul 0 rlineto \n\
\ boxLineWidth c3 neg mul boxLineWidth c2 neg mul rlineto \n\
\ } if \n\
\ \n\
\ ori 7 eq \n\
\ { w h moveto \n\
\ boxLineWidth c1 neg mul dup rmoveto \n\
\ 0 boxLineWidth c2 neg mul rlineto \n\
\ boxLineWidth c2 neg mul boxLineWidth c3 mul rlineto \n\
\ } if \n\
\ \n\
\ closepath \n\
\ 0.45 0.45 0.3 setrgbcolor \n\
\ fill \n\
\ grestore \n\
\ \n\
\ gsave \n\
\ closepath \n\
\ clip \n\
\ \n\
\ prNames { \n\
\ newpath \n\
\ 0 0 moveto \n\
\ boxLineWidth 2 mul boxLineWidth 4 mul rmoveto \n\
\ name show \n\
\ stroke \n\
\ } if \n\
\ grestore \n\
\ \n\
\ gsave \n\
\ 0.25 setgray \n\
\ boxLineWidth setlinewidth \n\
\ stroke \n\
\ grestore \n\
\ \n\
\ grestore \n\
\ \n\
\ end \n\
\} def \n\
\ \n\
\/wire { \n\
\ 5 dict begin \n\
\ /col exch def \n\
\ /y2 exch def \n\
\ /x2 exch def \n\
\ /y1 exch def \n\
\ /x1 exch def \n\
\ \n\
\ gsave \n\
\ newpath \n\
\ col setrgbcolor \n\
\ x1 y1 moveto \n\
\ x2 y2 lineto \n\
\ closepath \n\
\ stroke \n\
\ newpath \n\
\ x1 y1 wireWidth 0 360 arc \n\
\ closepath \n\
\ fill \n\
\ newpath \n\
\ x2 y2 wireWidth 0 360 arc \n\
\ closepath \n\
\ fill \n\
\ grestore \n\
\ end \n\
\} def \n\
\ \n\
\ \n\
\ \n\
\%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \n\
\%%% Draw floorplan \n\
\%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \n\
\ \n"