! EDWIN Device Driver for Postscript

! Revision History
! 14-DEC-1988  ANY   Completed
!
from Edwin include Device
from Edwin include Icodes
from Edwin include Specs
from Edwin include Consts
include IPROCS, PATTERN
from IMP include ASCII,LOGNAMES,MATHS

external long real function spec S TO R alias "IMP_S_TO_R" -
              (string(255) value)

! Control characters

! Plotting information and defaults
! The defaults, and external values are in mm
const real Default left margin = 15
const real Default bottom margin = 15
const real Default page width = 180
const real Default page length = 270
! Internally we work on inches, ugh
own real left margin
own real bottom margin
own real page width
own real page length
own real device resolution = 300
own byte Some Graphics Done = false
own integer XL    {               }
own integer XR    {   Window box  }
own integer YB    {               }
own integer YT    {               }

own integer CX    {   Current Position }
own integer CY    {                    }

own integer PX    {   Proper  Position }
own integer PY    {                    }

own integer Last Drew = 0
own integer Drawing Mode = 0
own integer current colour = 1
own integer Char Mirror = No Mirroring
own integer Current Char Size = 1
own integer Current Char Rot = 0
own integer Current Line Style = 0
own string (7) Current Poly = "eopoly"        { eopoly or dopoly as required }
own string(255) Char String = ""
own integer Num Spaces = 0
own string(255) Mirror = ""
const integer Max Fonts = 13
own string (31) array Fonts (0:Max Fonts) = "Courier",
                                               "Courier",
                                               "Courier-Bold",
                                               "Courier-Oblique",
                                               "Courier-BoldOblique",
                                               "Times-Roman",
                                               "Times-Bold",
                                               "Times-Italic",
                                               "Times-BoldItalic",
                                               "Helvetica",
                                               "Helvetica-Bold",
                                               "Helvetica-Oblique",
                                               "Helvetica-BoldOblique",
                                               "Symbol"
own integer Current Font = 0
own string(255) Font

external routine PS alias "EDWIN___P" (integer COM, X, Y)
   string(255) temp1,temp2,temp3,temp4
   own integer boxx=-1,boxy=-1
   integer I,J
 

   routine SWAP (integer name  A, B)
      integer C
      C = A;   A = B;   B = C
   end

   string(255) function I To Hex (integer Number)
      const byte array Letters (0:15) = '0','1','2','3','4','5','6','7',
                                    '8','9','A','B','C','D','E','F'
      string(255) Result = ""
      integer I,J
      for I = 1,1,4 cycle
          J = Number // 16
          Result = Letters(Number - J * 16).Result
          Number = J
      repeat
      result = result
   end

   routine TTString(string (255) Thing)
      integer I
      for I=1,1,Length(Thing) cycle
         TTPut(Charno(Thing,I))
      repeat
   end
   
   routine Newln
      TTput(nl)
   end
   
   real function Get Value (real default,string(255) Logical)
      string(255) Log Value = Translate(Logical)
      if Log Value = Logical start
         result = Default
      else
         result = stor(Log Value)
      finish
   end

   routine Fix Font
      string (255) Test String = "Edwin is WONDERFUL"
      Font = Fonts(Current Font)
      TTString("/".font." findfont setfont");newln
      TTString("/font_scale (".test string.") stringwidth pop ")
      TTString(itos(Length(test string),0)." div 1 exch div def");newln
      TTString("currentfont ".itos(Current Char Size,0)." font_scale mul ")
      TTString("scalefont setfont");newln
   end

   routine Output Char String
      long real Rot Angle
      integer String Width = Current Char Size * Length(Char String)
      if PX # CX or PY # CY then TTString(itos(PX,0)." ".itos(PY,0)." m");newln
      TTString("gsave currentpoint translate ")
      if Current Char Rot # 0 start
         TTstring(itos(Current Char Rot,0)." ")
         TTstring("rotate ")
      finish
      TTString(mirror)
      newln
      TTString(itos(Num Spaces,0)." ".itos(String Width,0))
      TTString(" (".char string.") edstr grestore");newln
      if Char Mirror & Mirror in Y Axis = Mirror in Y Axis start
         Rot Angle = (1 + Current Char Rot)/180 * PI
      else
         Rot Angle = Current Char Rot/180 * PI
      finish
      PX = PX + round(cos(Rot Angle) * String Width)
      PY = PY + round(sin(Rot Angle) * String Width)
      CX = -1
      CY = -1
      Char String = ""
      Num Spaces = 0
      Last Drew = COM
   end

   routine Clean Up Ends 
      return if Last Drew = 0
      if Last Drew = 6 and COM # 6 start
         Output Char String
      else if Drawing Mode = 3 and COM = 10
         TTString(current poly) and newln if Last Drew = 5
         CX = -1
         CY = -1
         Drawing Mode = 0
      finish
   end

   switch SW(0:MAX COM)

   routine CHANGE ATTRIBUTE (integer WHICH, TO)
      integer newto
      Clean Up Ends
      switch AS(0:ATT MAXIMUM)
      -> AS(WHICH)
   
AS(att Shade Mode):
      if TO > Max Pat or TO < 0 then TO = 1
      TTString("/fill_cur fill_".itos(TO,0)." def");newln
      return
      
AS(att Colour):
      if TO # 0 then newto= 0 else newto = 1
      if newto # current colour start
         TTString(itos(1-current colour, 0)." setgray");newln
         current colour = newto
      finish
      return

AS(att line style):
      if TO < 0 or TO > 4 then TO = 0
      if TO # Current Line Style start
         TTString("[")
         if TO = 1 start
            TTString("1 9")
         elseif TO = 2
            TTString("50 10 10 10")
         elseif TO = 3
            TTString("15")
         elseif TO = 4
            TTString("50 15")
         finish
         TTString("] 0 setdash");newln
         Current Line Style = To
      finish
      return

AS(att char size):
      if TO # Current Char Size start
          Current Char Size = TO
          TTString("/".font." findfont ".itos(TO,0)." font_scale mul ")
          TTString("scalefont setfont");newln
      finish
      return
   
AS(Att Char Rot):
      Current Char Rot = TO
      return

AS(Att Char Mirror):
      if TO = Mirror in X Axis start
         Mirror = "1 -1 scale"
      else if TO = Mirror in Y Axis
         Mirror = "-1 1 scale"
      else if TO = Mirror in Both Axes
         Mirror = "-1 -1 scale"
      else if TO = No Mirroring
         Mirror = ""
      else
         return
      finish
      Char Mirror = TO
      return

AS(att char font):
      if TO > Max Fonts or TO < 0 then TO = 0
      if Current Font # TO start
         Current Font = TO
         FixFont
      finish
      return

AS(att poly render):
      if Y=0 start
         current poly = "eopoly"
      else
         current poly = "dopoly"
      finish
      return

AS(*): ! Ignore all other attributes
   end

   routine Establish Graphics Defaults
      integer I, J
      TTString("%! Edwin PostScript Output");newln
      TTString("initgraphics");newln
      TTString("/m {moveto} def");newln
      TTString("/l {lineto} def");newln
      TTString("/cp {closepath} def");newln
      TTString("/np {newpath} def");newln
      TTString("/st {currentpoint stroke moveto} def");newln
      TTString("/rl {rlineto st} def");newln
      TTString("/rln {rlineto} def");newln
      Read Patterns(round(device resolution))
      TTstring("/quad {/tempstring exch def ");newln
      TTstring("/outstring tempstring length 16 mul string def");newln
      TTstring("0 1 15 {/whichln exch def ");newln
      TTstring("/thisln tempstring whichln 2 mul 2 getinterval def");newln
      TTstring("0 128 384 {/y exch def 0 2 6 {/x exch def");newln
      TTstring("outstring whichln 8 mul x add y add thisln putinterval");newln
      TTstring("} for } for } for outstring} def");newln
      for I = 0,1,Max Pat cycle
          TTString("/fill_".itos(I,0)." <")
          for J = 0,1,15 cycle
              TTString(I To Hex(Patterns(I*16+J)))
          repeat
          TTString("> quad def");newln
      repeat
      TTString("/fill_cur fill_0 def");newln
      TTString("/dopoly { fill_cur fill_0 eq {stroke}");newln
      TTString("{fill_cur fill_1 eq {gsave fill grestore stroke}");newln
      TTString("{pathbbox");newln
      TTString("/uy exch def");newln
      TTString("/ux exch def");newln
      TTString("/ly exch cvi 16 idiv 16 mul def");newln
      TTString("/lx exch cvi 16 idiv 16 mul def");newln
      TTString("gsave clip");newln
      TTString("lx 64 ux {/tx exch def ly 64 uy {/ty exch def ");newln
      TTString("gsave tx ty translate");newln
      TTString("64 64 true [1 0 0 -1 0 64] {fill_cur} imagemask grestore");newln
      TTString("}for}for");newln
      TTString("grestore stroke} ifelse } ifelse } def");newln
      TTString("/b {/ybit exch def /xbit exch def currentpoint np m");newln
      TTString("0 ybit rlineto xbit 0 rlineto ")
      TTString("0 ybit neg rlineto xbit neg 0 rlineto");newln 
      TTString("dopoly} def");newln
      TTString("/eopoly { fill_cur fill_0 eq {stroke}");newln
      TTString("{fill_cur fill_1 eq {gsave eofill grestore stroke}");newln
      TTString("{pathbbox");newln
      TTString("/uy exch def");newln
      TTString("/ux exch def");newln
      TTString("/ly exch cvi 16 idiv 16 mul def");newln
      TTString("/lx exch cvi 16 idiv 16 mul def");newln
      TTString("gsave eoclip");newln
      TTString("lx 64 ux {/tx exch def ly 64 uy {/ty exch def ");newln
      TTString("gsave tx ty translate");newln
      TTString("64 64 true [1 0 0 -1 0 64] {fill_cur} imagemask grestore");newln
      TTString("}for}for");newln
      TTString("grestore stroke} ifelse } ifelse } def");newln
      TTString("/b {/ybit exch def /xbit exch def currentpoint np m");newln
      TTString("0 ybit rlineto xbit 0 rlineto ")
      TTString("0 ybit neg rlineto xbit neg 0 rlineto");newln 
      TTString("eopoly} def");newln
      TTString("/edstr {");newln
      TTString("/outstring exch def /strwid exch def /numspace exch def");newln
      TTstring("numspace 0 eq {outstring show} {");newln
      TTString("outstring stringwidth pop strwid exch sub numspace div");newln
      TTString("0 8#040 outstring widthshow} ifelse} def");newln
      temp1 = rtos(72 / device resolution,0,4)
      temp2 = rtos(device resolution * (Left Margin + Page Width),0,4)
      temp3 = rtos(device resolution * Bottom Margin,0,4)
      TTString(temp1." ".temp1." scale");newln
      TTString("90 rotate");newln
      TTString(temp3." -".temp2." translate");newln
      TTString("0 0 m");newln
      if Translate("EDWIN_PS_FONT") # "EDWIN_PS_FONT" start
          Fonts(0) = Translate("EDWIN_PS_FONT")
      finish
      Fix Font
      CX = 0
      CY = 0
      PX = CX
      PY = CY
   end

   -> SW(COM)

SW(0): ! Initialise
      dev data_name = "a Postscript file"
      Left Margin = get value(Default Left Margin,"EDWIN_PS_LEFT_MARGIN") / 25.4
      Bottom Margin = get value(Default Bottom Margin,"EDWIN_PS_BOTTOM_MARGIN") / 25.4
      Page Width = get value(Default Page Width,"EDWIN_PS_PAGE_X") / 25.4
      Page Length = get value(Default Page Length,"EDWIN_PS_PAGE_Y") / 25.4
      Device Resolution = get value(Device Resolution,"EDWIN_PS_DEVICE_RESOLUTION")
      XL = 0
      YB = 0
      XR = round(Page Length * Device Resolution)
      YT = round(Page Width * Device Resolution)
      dev data_Mvx = XR
      dev data_Mvy = YT
      dev data_Dvx = XR
      dev data_Dvy = YT
      dev data_Max Styles = 4
      dev data_Num Char Rots = 255
      dev data_Num Char Sizes = 255
      I = round(device resolution / 2.54)
      dev data_X Units Per Cm = I
      dev data_Y Units Per Cm = I
      Set Device("EDWIN_PS") if Viewing = 0
      Establish Graphics Defaults
      return

SW(1): !Terminate
      Clean Up Ends
      TTString("showpage");newln
      Flush Output
      return

SW(2): ! Update
      Clean Up Ends
      return

SW(3): ! New frame
      if Some Graphics Done = true start 
         Clean Up Ends
         TTString("showpage");newln
         Flush Output
         Establish Graphics Defaults
         Last Drew = 0
         ps (9, xr, yt) { re-establish window size }
      finish
      Some Graphics Done = false
      return

SW(4): ! Move Abs
      Clean Up Ends
      PX = X
      PY = Y
      return

SW(5): ! Line Abs
      Clean Up Ends
      if PX # CX or PY#CY start
         TTString(itos(PX,0)." ".itos(PY,0)." m");newln
      finish
      TTString(itos(X-PX,0)." ".itos(Y-PY,0)." rl")
      if Drawing Mode = 3 then TTPut('n')
      newln
      PX = X
      PY = Y
      CX = PX
      CY = PY
      Flush Output
      Some Graphics Done = True
      Last Drew = COM
      return

SW(6): ! Character
      Some Graphics Done = True
      Clean Up Ends
      Char String = Char String.X
      Num Spaces = Num Spaces + 1 if X = ' '
      if Length(Char String) = 255 then Output Char String
      Last Drew = 6
      return

SW(7): ! Attribute  Change
      Change Attribute(X,Y)
      return

SW(8): ! Lower window bounds
      XL = X
      if XL < 0 then XL = 0
      YB = Y
      if YB < 0 then YB = 0
      return

SW(9): ! Upper window bounds
      Clean Up Ends
      XR = X
      if XR > dev data_mvx then XR = dev data_mvx
      YT = Y
      if YT > dev data_mvy then YT = dev data_mvy
      TTString("np ".itos(XL,0)." ".itos(YB,0)." m");newln
      TTstring(itos(XL,0)." ".itos(YT,0)." l");newln
      TTString(itos(XR,0)." ".itos(YT,0)." l");newln
      TTString(itos(XR,0)." ".itos(YB,0)." l");newln
      TTString("cp clippath np");newln
      CX = -1
      CY = -1
      Last Drew = COM
      return

SW(10): ! Set Drawing Mode
      Clean Up Ends
      Drawing Mode = X
      Last Drew = COM
      return

SW(12): ! Lower box bounds
        boxx = x
        boxy = y
        return

SW(13): ! Upper box bounds
        Clean Up Ends
        if X < BoxX then swap(X,BoxX)
        if Y < BoxY then swap(Y,BoxY)
        return if BoxX > XR or X < XL or BoxY > YT or Y < YB
        BoxX = XL if BoxX < XL
        BoxY = YB if BoxY < YB
        X = XR if X > XR
        Y = YT if Y > YT
        ! Box now clipped into the screen.
        Com = Current Line Style
        if Current Line Style # 0 start
           ! Set solid lines to border the box, restore afterwards
           TTString("[] 0 setdash");newln
           Current Line Style = 0
        finish
        if BoxX # CX or BoxX # CY start
           TTString(itos(BoxX,0)." ".itos(BoxY,0)." m");newln
        finish
        TTString(itos(X-BoxX,0)." ".itos(Y-BoxY,0)." b");newln
        Change Attribute (Att Line Style, Com) if Com # 0
        CX = -1
        CX = -1
        PX = X
        PY = Y
        Some Graphics Done = True
        Flush Output
        Last Drew = 13
        return

SW(14): ! Draw Circle
      Clean Up Ends
      
      if PX + X # CX or PY # CY start
         TTString(itos(PX+X,0)." ".itos(PY,0)." m");newln
      finish
      TTString(itos(PX,0)." ".itos(PY,0)." ".itos(X,0)." 0 360 arc dopoly");newln
      CX = PX + X
      CY = PY
      return
        
SW(*):
end

end of file