    ! 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