1 -------------------------------------------------------------------------------- 2 -- Copyright 1994 by Peter Thiemann 3 -- $Log: FigOutput.hs,v $ 4 -- Revision 1.1 1996/01/08 20:02:34 partain 5 -- Initial revision 6 -- 7 -- Revision 1.2 1994/03/15 15:34:53 thiemann 8 -- added full color support, XColorDB based 9 -- 10 -- Revision 1.1 1993/08/31 12:31:32 thiemann 11 -- Initial revision 12 -- 13 -- $Locker: $ 14 -------------------------------------------------------------------------------- 15 16 module FigOutput (figShowsWrapper) where 17 18 import Fonts (FONT, fontName, fontScale) 19 import Color 20 import Info 21 22 -------------------------------------------------------------------------------- 23 figShowsWrapper :: WrapperType 24 figShowsWrapper title 25 (borderDistX, borderDistY, lineWidth, fatLineWidth, arrowSize, ntFont, tFont, _) 26 container@(rx, ry, width, height, inOutY, gobj) = 27 showString "#FIG 2.1\n" . 28 showString "2 80\n" . 29 {- showString "1 80\n" . (origin in lower left) is ignored -} 30 figShowsContainer rx height container 31 where 32 figShowsContainer ax ay (rx, ry, width, height, inOutY, gobj) = 33 case gobj of 34 AString color font theString -> 35 showString "4 0" . -- object type, sub_type (left just) 36 showsTrueNum (figFont (fontName font)) . -- font (enumeration type) 37 showsTrueNum (fontScale font) . -- font_size (points) 38 showString " 0" . -- pen 39 showsFigColor color . -- color 40 showString " 0 0.00000 4" . -- depth, angle, font_flags 41 showsFigNum height . -- height 42 showsFigNum width . -- length 43 showsFigNum ax' . -- x 44 showsFigNum ay' . -- y 45 showString (' ':theString++"\1\n") -- string 46 ABox color rounded content -> 47 figShowsContainer ax' ay' content . 48 showString "2" . 49 showString (if rounded then " 4" else " 2") . 50 showString " 0 " . -- object, subobject (box), line style 51 showsFigNum fatLineWidth . -- thickness (pixels) 52 showsFigColor color . -- color 53 showString " 0 0 0" . -- depth, pen, area_fill 54 showString " 0.000" . -- style_val 55 (if rounded then showsFigNum (min width height `div` 2) 56 else showString " 0") . 57 showString " 0 0\n" . -- forward_arrow, backward_arrow 58 showsFigPoint ax' ay' . 59 showsFigPoint (ax'+width) ay' . 60 showsFigPoint (ax'+width) (ay'-height) . 61 showsFigPoint ax' (ay'-height) . 62 showsFigPoint ax' ay' . 63 showsFigLastPoint 64 Arrow color size -> 65 showString "2 1 0" . -- a polyline 66 showsFigNum lineWidth . 67 showsFigColor color . 68 showString " 0 0 0 0.000 -1 1 0\n" . 69 showString " 0 0" . -- arrow_type, arrow_style 70 showsFigNum lineWidth . showString ".000" . -- arrow_thickness 71 showsFigNum (abs size * 2) . showString ".000" . -- arrow_width 72 showsFigNum (abs size * 2) .showString ".000\n" . -- arrow_height 73 showString " " . 74 showsFigPoint (ax'-size) ay' . 75 showsFigPoint ax' ay' . 76 showsFigLastPoint 77 Aline color -> 78 showString "2 1 0" . 79 showsFigNum lineWidth . 80 showsFigColor color . 81 showString " 0 0 0 0.000 -1 0 0\n" . 82 showString " " . 83 showsFigPoint ax' ay' . 84 showsFigPoint (ax'+width) (ay'-height) . 85 showsFigLastPoint 86 ATurn color dir -> 87 showString "3 0 0" . -- a spline object 88 showsFigNum lineWidth . 89 showsFigColor color . 90 showString " 0 -1 0 0.0 0 0\n" . 91 showsIt dir . 92 showsFigLastPoint 93 where showsIt SE = showsFigPoint ax' ay' . 94 showsFigPoint ax' (ay'-height) . 95 showsFigPoint (ax'+width) (ay'-height) 96 showsIt WN = showsFigPoint ax' ay' . 97 showsFigPoint (ax'+width) ay' . 98 showsFigPoint (ax'+width) (ay'-height) 99 showsIt SW = showsFigPoint (ax'+width) ay' . 100 showsFigPoint (ax'+width) (ay'-height) . 101 showsFigPoint ax' (ay'-height) 102 showsIt NE = showsFigPoint ax' (ay'-height) . 103 showsFigPoint ax' ay' . 104 showsFigPoint (ax'+width) ay' 105 AComposite contents -> 106 showString "6" . 107 showsFigPoint (ax'+width) (ay'-height) . 108 showsFigPoint ax' ay' . 109 showChar '\n' . 110 foldr (.) (showString "-6\n") (map (figShowsContainer ax' ay') contents) 111 where ax' = ax + rx 112 ay' = ay - ry 113 114 figFont name = lookup figFontList 0 115 where 116 lookup [] _ = -1 117 lookup (font: fonts) n | font == name = n 118 | otherwise = lookup fonts (n+1) 119 120 figFontList = [ -- stolen from u_fonts.c 121 "Times-Roman", 122 "Times-Italic", 123 "Times-Bold", 124 "Times-BoldItalic", 125 "AvantGarde-Book", 126 "AvantGarde-BookOblique", 127 "AvantGarde-Demi", 128 "AvantGarde-DemiOblique", 129 "Bookman-Light", 130 "Bookman-LightItalic", 131 "Bookman-Demi", 132 "Bookman-DemiItalic", 133 "Courier", 134 "Courier-Oblique", 135 "Courier-Bold", 136 "Courier-BoldOblique", 137 "Helvetica", 138 "Helvetica-Oblique", 139 "Helvetica-Bold", 140 "Helvetica-BoldOblique", 141 "Helvetica-Narrow", 142 "Helvetica-Narrow-Oblique", 143 "Helvetica-Narrow-Bold", 144 "Helvetica-Narrow-BoldOblique", 145 "NewCenturySchlbk-Roman", 146 "NewCenturySchlbk-Italic", 147 "NewCenturySchlbk-Bold", 148 "NewCenturySchlbk-BoldItalic", 149 "Palatino-Roman", 150 "Palatino-Italic", 151 "Palatino-Bold", 152 "Palatino-BoldItalic", 153 "Symbol", 154 "ZapfChancery-MediumItalic", 155 "ZapfDingbats"] 156 157 showsTrueNum :: Int -> ShowS 158 showsTrueNum x = showChar ' ' . shows x 159 160 showsFigNum :: Int -> ShowS 161 showsFigNum x = showChar ' ' . shows ((x*9 + 999) `div` 1000) -- sorry about that 162 163 showsFigPoint :: Int -> Int -> ShowS 164 showsFigPoint x y = showsFigNum x . showsFigNum y 165 166 showsFigLastPoint :: ShowS 167 showsFigLastPoint = showString " 9999 9999\n" 168 169 -- showsFigColor :: Int -> ShowS 170 -- showsFigColor c = showChar ' ' . showsColor c