module Layout.Postscript where import Data.String import Data.Hardware.Internal import Layout.Floorplan type Postscript = ShowS class Show a => PSShow a where psShow :: a -> Postscript instance PSShow Int where psShow n = shows n instance (IsString a, Show a) => PSShow a where psShow a = "(" .+ shows a .+ ")" deriving instance PSShow Width deriving instance PSShow Height 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 | w * icast h > 0 = unwordS [ psShow x , psShow y , psShow w , psShow h , psShow ori , psShow nm , "block\n" ] floorplanToPS :: Floorplan s b -> (Postscript, Size) floorplanToPS fp = (absToPS afp, sz) where (afp,sz) = absolutize fp linesToPS :: [(Position,Position)] -> Postscript linesToPS [] = id linesToPS (line:lines) = unwordS [ psShow x1, psShow y1 , psShow x2, psShow y2 , "wire\n" ] .+ linesToPS lines where ((x1,y1),(x2,y2)) = line renderFloorplan_ :: Int -> String -> Floorplan s b -> [(Position,Position)] -> 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 -- .+ "\nshowpage\n" -- *** This should make a first page without wires, but it doesn't seem to -- work. .+ "\nwireWidth setlinewidth\n\n" .+ linesToPS lines $ "\nshowpage\n" where (ps,sz) = floorplanToPS fp lnScLine = shows lnScale .+ showString (replicate (6 - length (show lnScale)) ' ') .+ "% Scale for lines and names\n" setPicSize (x,y) = unlineS [ "/picW " .+ shows (toInt x) .+ " def" , "/picH " .+ shows (toInt y) .+ " def" , " % Width/heigth of picture (in floorplan units)" , "" ] -- The first parameter is the scale for lines and names. renderFloorplan :: String -> Floorplan s b -> IO () renderFloorplan title fp = renderFloorplan_ 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\ \ 4 dict begin \n\ \ /y2 exch def \n\ \ /x2 exch def \n\ \ /y1 exch def \n\ \ /x1 exch def \n\ \ \n\ \ gsave \n\ \ newpath \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"