                    {###################################}
                    {#       Copyright (C) 1987        #}
                    {#      Lattice Logic Limited      #}
                    {#         9, Wemyss Place         #}
                    {#        Edinburgh EH3 6DH        #}
                    {#            Scotland             #}
                    {#                                 #}
                    {#       All rights reserved       #}
                    {###################################}

    ! This module contains the support routines for the scrdrive package and
    ! edwin device driver for the definicon board's interface with the famous
    ! GEM package

    from Imp   include DOS       end of list
    from Imp   include ASCII     end of list
    from Imp   include LogNames  end of list
    from Imp   include MCode     end of list
    from Edwin include Consts    end of list
    from Edwin include GemConst  end of list
    from LL    include Common    end of list

    string(255) function Env String(string(31) Name, string(255) Variable)
       string(255) Value

       Value = Translate(Name."_".Variable)
       result = Value if Value # Name."_".Variable
       Value = Translate("LL_".Variable)
       result = Value if Value # "LL_".Variable
       result = ""
    end

    integer function Env Integer(string(31) Name, string(255) Variable,
                                   integer Default)
       on event * start
          result = Default
       finish

       Variable = Env String(Name, Variable)
       result = Default if Variable = ""
       result = S To I(Variable)
    end

    integer function Env Switch(string(31) Name, string(255) Variable,
                                  integer Exist, Not Exist)

       Variable = Env String(Name, Variable)
       result = Exist if Variable # ""
       result = Not Exist
    end

    {##############################################}
    {#                                            #}
    {#           Basic GEM Driver                 #}
    {#                                            #}
    {##############################################}

    external string(31) spec Fname

    constant integer Screen Device      = 1
    constant integer Metafile Device    = 31
    own integer Current Device

    constant integer Max Vertices = 127
    constant integer Max Ints     = 128

    record format Gem Parm Fm(integer Contrl,
                                         Intin,
                                         Ptsin,
                                         Intout,
                                         Ptsout)

    record format Gem Control Fm(short array C(0:11) or
                                   short Opcode,
                                          Ptsin  Len,
                                          Ptsout Len,
                                          Intin  Len,
                                          Intout Len,
                                          Sub Function,
                                          Handle)

    record format Gem Integer Fm(short array X(0: Max Ints-1))

    record format Gem Vertice Fm(short array X(0: Max Vertices*2-1))

    record format Gem Fm(record(Gem Parm Fm)    Parm,
                           record(Gem Control Fm) Contrl,
                           short array           Parms(0: 511),
                           record(Gem Vertice Fm) Ptsin, Ptsout,
                           record(Gem Integer Fm) Intin, Intout)

    own record(Gem Fm) Gem = 0
    own integer Gem Buffer Size = 0

    own integer Gem Addr = 0,
                  Gem Log,
                  MFDB Log,
                  MFDB Addr

    own short name Opcode,
                      Ptsin Len,
                      Ptsout Len,
                      Intin Len,
                      Intout Len
    own short array name Ptsin,
                             Ptsout,
                             Intin,
                             Intout,
                             PA
    own record(Gem Parm Fm) name PB

    !
    ! Keyboard type ahead held in a sort of circular buffer
    !
    ! Nothing to read if read ptr=add ptr
    ! If buffer full add ptr will push read ptr on one
    !

    own integer escape char
    external byte integer spec int flag alias "IMP___INT_FLAG"

    constant integer Max Type Ahead = 63         {must be a power of two-1}
    own byte array Buffer(0: Max Type Ahead)
    own integer add ptr=0
    own integer read ptr=0

    routine Advance(integer name Ptr)
       Ptr = (Ptr+1) & Max Type Ahead
    end

    routine Add To Buffer(byte Char)
       Buffer(Add Ptr) = Char
       Advance(Add Ptr)
       Advance(Read Ptr) if Read Ptr = Add Ptr
    end

    integer function Top Of Buffer
       result = -1 if Read Ptr = Add Ptr
       integer I = Buffer(Read Ptr)
       Advance(Read Ptr)
       result=i
    end

    routine Clear Buffer
       Read Ptr = Add Ptr
    end

    external routine do check alias "G_CK_INT"
       constant integer zero flag=64
       record(Int Regs Fm) Regs

       Regs=0
       Regs_Ah<-Dos Fn Direct Console IO
       Regs_Dl<-16_FF       {wanting input}
       Int86(Dos Int Function Request,Regs)
       if regs_flags&zero flag=0 start
          if regs_al=escape char start
             int flag=1
             Clear Buffer
          else
             Add To Buffer(regs_al)
          finish
       finish
    end

    routine check interrupt
       constant integer max cycle=50
       own integer cycle=max cycle

       return if current device#screen device
       !
       ! test for attempted interrupt every max cycles calls of the routine
       !
       cycle=cycle-1
       return if cycle>0
       cycle=max cycle
       do check
    end

    predicate Interested In Return Values(integer Opcode)
       false if 2<=Opcode<=11 or Opcode=114 or 122<=Opcode<=123
       true
    end

    routine copy arrays               {load parameters into gem parameter block}
       integer j,p=ptsin len*2

       PB_Intin=PB_ptsin+p*2           {2*2 bytes per vertice parameter}
       PB_ptsout=PB_intin+intin len*2  {2 bytes per integer parameter}
       PB_intout=PB_ptsout+40          {+max ptsout len*4}
       pa(j)=ptsin(j) for j=0,1,p-1
       pa(p+j)=intin(j) for j=0,1,intin len-1
       gem buffer size=size of(PB)+size of(gem_contrl)+p*2+intin len*2
       gem buffer size=gem buffer size+130 if interested in return values(opcode)
    end                               {+max ptsout len*4+max intout len*2}

    routine copy back arrays          {copy gem P.B. back into data structure}
       integer i,j

       i=intin len+ptsin len*2
       ptsout(j)=pa(i+j) for j=0,1,ptsout len*2-1
       i=intin len+ptsin len*2+20      {+max ptsout*2}
       intout(j)=pa(i+j) for j=0,1,intout len-1
    end

    routine Initialise Gem
       own byte array MFDB(1:20)=0(*)

       return if Gem Addr # 0

       Opcode     == Gem_Contrl_Opcode
       Ptsin      == Gem_Ptsin_X
       Ptsout     == Gem_Ptsout_X
       Intin      == Gem_Intin_X
       Intout     == Gem_Intout_X
       Ptsin Len  == Gem_Contrl_Ptsin Len
       Ptsout Len == Gem_Contrl_Ptsout Len
       Intin Len  == Gem_Contrl_Intin Len
       Intout Len == Gem_Contrl_Intout Len
       PA         == Gem_Parms
       PB         == Gem_Parm

       Gem Log  = Mal 86(Size Of(Gem) + 20)   {Allocate memory for GEM parameters}
       Gem Addr = (Gem Log>>12) & 16_FFFF0 + (Gem Log & 16_FFFF)

       MFDB Log  = Gem Log + Size Of(Gem)     {The last 20 bytes holds a MFDB}
       MFDB Addr = Gem Addr + Size Of(Gem)    {for scrolling raster operations}
       To86(MFDB(1), MFDB addr, 20)           {MFDB is zero for physical dev}

       PB_Contrl = Gem Log + Addr(Gem_Contrl) - Addr(Gem)
       PB_Ptsin  = Gem Log + Addr(Gem_Parms) - Addr(Gem)

       Escape Char = Env Integer(Fname, "ESCAPE_CHAR", 'Y'-'A'+1)
       Int Flag = 0
    end

    own integer mouse addr
    own byte retf=16_cb,original byte=16_55

    routine Do Gem
       record(Int Regs Fm) Regs=0

       Regs_Ds<-Gem Log>>16
       Regs_Dx<-Gem Log&16_FFFF
       Regs_Cx<-16_0473
       Copy Arrays
       to86(retf,mouse addr,1) unless interested in return values(opcode)
       To86(Byte(Addr(Gem)),Gem Addr,Gem buffer size)
       Int86(16_EF,Regs)
       if interested in return values(opcode) start
          Fr86(Gem Addr,Byte(Addr(Gem)),Gem buffer size)
          copy back arrays
       else
          to86(original byte,mouse addr,1)
       finish
       Intin Len=0
       Ptsin Len=0
       check interrupt
    end

    !
    ! set up the cursor so that it is displayed as much as possible
    !
    routine cursor status(integer onoff)
       own integer status=hide cursor

       return if status=onoff
       status=onoff
       opcode=status
       ptsin len=0
       intin len=1
       intin(0)=1
       do gem
    end

    routine gem command(short opc)

       ! make sure that the cursor is off if something is being drawn,
       ! otherwise it doesn't matter
       !
       cursor status(hide cursor) unless interested in return values(opc)
       Opcode=opc
    end

    routine Add Ptsin(integer I,J)
       integer P=Ptsin Len*2

       Ptsin(P)<-I
       Ptsin(P+1)<-J
       Ptsin Len=Ptsin Len+1
    end

    routine add ptsin array(integer pts, integer array name xs,ys)
       integer i,p=Ptsin Len*2

       for i=1,1,pts cycle
          ptsin(p)<-xs(i)
          ptsin(p+1)<-ys(i)
          p=p+2
       repeat
       ptsin len=ptsin len+pts
    end

    routine Add Intin(integer I)

       Intin(Intin Len)<-I
       Intin Len=Intin Len+1
    end

    routine Add String(byte name C Str)
       integer A = Addr(C Str)

       while Byte(A) # 0 and Intin Len <= Max Ints cycle
          Intin(Intin Len) = Byte(A)
          Intin Len = Intin Len+1
          A = A+1
       repeat
    end

    integer function clength(byte name cstr)
       integer i=0,a=addr(cstr)

       i=i+1 while byte(a+i)#0
       result=i
    end

    {##############################################}
    {#                                            #}
    {#        EDWIN package support               #}
    {#                                            #}
    {##############################################}

    constant integer CGA = 200,
                       EGA = 350,
                       VGA = 480

    constant integer Meta Width  = 3800    {Not what you might expect from the}
    constant integer Meta Height = 2570    {documentation, but then what's new?}

    constant integer System Text Face   = 1
    constant integer Software Text Face = 2

    external integer function spec Imp Creat alias "IMP_CREAT" -
                                 (string(255) Name, integer Mode)

    dynamic integer spec Errno alias "errno"
    constant integer Open Mode Write = 1

    own integer Current Text Face
    own integer Graphics Standard
    own integer GEM Version

    !
    ! Scrdrive package support. Remember to compile with the correct
    ! definicon map file
    !
    external integer spec Off Y alias "OffY"
    external integer Letter X   alias "LetterX"
    external integer Letter Y   alias "LetterY"
    external integer Win X      alias "WinX"
    external integer Win Y      alias "WinY"
    external integer Max X      alias "MaxX"
    external integer Max Y      alias "MaxY"
    external integer Cur X      alias "CurX"
    external integer Cur Y      alias "CurY"
    external integer spec Char X alias "CharX"
    external integer spec Char Y alias "CharY"
    external integer Char Fixed alias "CharFixed"

    constant integer Default = 1, Background = 0

    record format Environment Fm(integer array Variable(1:5) or
                                   integer Char Size,
                                            Line Style,
                                            Fill Mode,
                                            Colour,
                                            Raster Op)

    own record(Environment Fm) Current, Actual

    own integer Variable Char Size
    own integer real colours
    own integer screen aspect ratio
    own integer initialised edwin=0

    external routine spec Edwin Line Style alias "EDWIN_DD_STYLE"(integer Style)
    external routine spec Edwin Colour alias "EDWIN_DD_COL"(integer mode)
    external routine spec Edwin Mode alias "EDWIN_DD_MODE"(integer mode)
    external routine spec Edwin Fill alias "EDWIN_DD_FILL"(integer mode)
    external routine spec Edwin Clear alias "EDWIN_DD_CLEAR"

    own integer Prev Dev, Prev Handle, Prev Mouse Addr, Prev Screen Size
    own integer Screen File Descriptor, Nul File Descriptor

    own integer Pts=0
    own integer array Line X(0:Max Vertices-1)
    own integer array Line Y(0:Max Vertices-1)

    from Edwin include Gem Hatch

    own integer array Line Map(0:7) = 2_1111111111111111,
                                         2_1100110011001100,
                                         2_1111111110011100,
                                         2_1100000011000000,
                                         2_0001111000011110,
                                         2_1010111111111010,
                                         2_1110011111111100,
                                         2_1110001110001110

    constant integer Red Col  =  16_00030000
    constant integer Blu Col  =  16_00000003
    constant integer Gre Col  =  16_00000300
    constant integer Whi Col  =  16_00030303
    constant integer Bla Col  =  16_00000000
    constant integer Yel Col  =  16_00030300
    constant integer Mag Col  =  16_00030003
    constant integer Cya Col  =  16_00000303

    external integer array C Map(0:7) = Bla Col, Red Col, Yel Col, Yel Col,
                                           Cya Col, Cya Col, Cya Col, Whi Col

    external integer MonoChrome        = 0 ,
                       BackGround Col    = 0,
                       ForeGround Col    = 1,
                       Text Col          = 2,
                       HighLight Col     = 4

    external integer array P map(0:15)=0,1,4,3,2,7,6,5,8,9,10,11,12,13,14,15

    own string(127) fill pattern bitmap
    own integer Fill Type, Fonts, Extents Flag

    external routine Load Colours
       integer i

       for i=0, 1, 7 cycle
           Gem Command(Set Colour Representation)
           Add Intin(P Map(i))
           Add Intin(333 * (  C Map(PMap(i)) >>16))
           Add Intin(333 * (( C Map(PMap(i)) >>8 ) & 16_FF))
           Add Intin(333 * (  C Map(PMap(i)) &16_FF))
           Do Gem
        repeat
    end

    external routine Read Environment For alias "RD_ENV"(string(31) Name)
       string(16) Red Map, Green Map, Blue Map
       string(255) colour
       integer Map Length, i

       if Real Colours > 2 start
          if Name = "WAVE" start
    !
    ! This is a frig to get the highlight col into slot 1 of the colour map.
    ! The xor function always results in the colour in slot one
    !
             i = C map(PMap(Foregroundcol))
             C Map(PMap(Foregroundcol)) = C map(PMap(Highlightcol))
             C Map(PMap(Highlightcol)) = i
             i = foregroundcol
             foregroundcol = highlightcol
             highlightcol = i
             Load Colours
          else if Name = "EXERT"
             Load Colours
          else
             Backgroundcol = 0
             Textcol       = 1
             Foregroundcol = 1
             Highlightcol  = 1
             Red   Map <- Env String(Name, "RED___INTENSITY")
             Green Map <- Env String(Name, "GREEN_INTENSITY")
             Blue  Map <- Env String(Name, "BLUE__INTENSITY")
             Map Length = Length(Red   Map)
             Map Length = Length(Green Map) if Length(Green Map) < Map Length
             Map Length = Length(Blue  Map) if Length(Blue  Map) < Map Length
             for i=0, 1, Map Length-1 cycle
                Gem Command(Set Colour Representation)
                Add Intin(PMap(i))
                Add Intin(333 * (Char No(Red   Map, i+1)-'0'))
                Add Intin(333 * (Char No(Green Map, i+1)-'0'))
                Add Intin(333 * (Char No(Blue  Map, i+1)-'0'))
                Do Gem
             repeat
          finish
       finish

       Variable Char Size = Env Switch(Name, "VAR_CHAR_SIZE", 1, 0)

       Extents Flag = '`'{Env Integer(Name, "EXTENTS_FLAG", '`')

       Current_Char Size = Env Integer(Name, "CHAR_HEIGHT", 30)
       Current_Char Size = (Current_Char Size*72) // (25400//Screen Aspect Ratio)

       Current Text Face = Env Switch(Name, "FIXED_FONT", System Text Face,
                                                    Software Text Face)
       Current Text Face = System Text Face if Fonts = 0
       Gem Command(Set Text Face)
       Add Intin(Current Text Face)
       Do Gem

    end

    external routine Edwin Initialise alias "EDWIN_DD_INIT"-
                                       (integer name Max X, Max Y, integer Dev)
       record(Int Regs Fm) Regs=0

       routine Open Screen
          constant integer array meta xl(1:2)=660,520
          constant integer array meta yl(1:2)=32410,32630
          constant integer array meta xh(1:2)=10060,4550
          constant integer array meta yh(1:2)=26590,30100

          short Mouse Segment, Mouse Offset
          integer i

          Actual_Variable(i) = -1 for i=1, 1, 5

          Gem Command(Open Workstation)
          Add Intin(Current Device)
          Add Intin(1)  {Line type}
          Add Intin(0)  {Polyline colour}
          Add Intin(1)  {Marker type}
          Add Intin(0)  {Marker colour}
          Add Intin(Current Text face)
          Add Intin(0)  {Text colour}
          Add Intin(2)  {fill interior style}
          Add Intin(8)  {fill style index}
          Add Intin(0)  {Fill colour}
          Add Intin(2)  {Raster coords}
          Do Gem
          stop if Gem_Contrl_Handle = 0

          Max X = Intout(0)
          Max Y = Intout(1)
          Win X = Max X
          Win Y = Max Y
          Char Fixed = 0

          Real Colours = Intout(13)
          MonoChrome = 1 if Real Colours < 3
          Graphics Standard = CGA
          Graphics Standard = EGA if Max Y >= 300
          Graphics Standard = VGA if Max Y >= 480
          if GEM Version = 3 start
             Screen Aspect Ratio = (100*Max Y)//Graphics Standard
          else
             if Real Colours > 2 start
                Screen Aspect Ratio = 100
             else
                Screen Aspect Ratio = 200
             finish
          finish

          Gem Command(Fill Rectangle)
          Add Ptsin(0, 0)
          Add Ptsin(Win X, Win Y)
          Do Gem

          Gem Command(Exchange Cursor Change Vector)       {Ugly repulsive fix}
          Do Gem                                           {for the EGA card}
          Mouse Offset = Gem_Contrl_C(9)                   {basically prevents}
          Mouse Segment = Gem_Contrl_C(10)                 {a mouse interrupt}
          Gem Command(Exchange Cursor Change Vector)       {being serviced while}
          Gem_Contrl_C(7) = Mouse Offset                   {a drawing operation}
          Gem_Contrl_C(8) = Mouse Segment                  {is being executed.}
          Do Gem
          Mouse Addr = Mouse Segment<<4 + Mouse Offset
          Fr 86(Mouse Addr, Original Byte, 1)

          Gem Command(Load Fonts)
          Add Intin(0)
          Do Gem
          Fonts = Intout(0)

          Gem Command(Set Polyline Line Type)
          Add Intin(7)
          Do Gem

          if current device=metafile device start
             !
             ! use an escape command to change the name of the output file
             ! from the standard gemfile.gem filename to productname.gem
             ! eg draft.gem or cifview.gem
             !
             gem command(escape)
             gem_contrl_sub function=100
             charno(fname,length(fname)+1)=0
             add string(charno(fname,1))
             do gem
             gem command(escape)
             gem_contrl_sub function=99
             add intin(0)
             add intin(meta width)
             add intin(meta height)
             do gem
             gem command(escape)
             gem_contrl_sub function=99
             add intin(1)
             add intin(meta xl(prev screen size))
             add intin(meta yl(prev screen size))
             add intin(meta xh(prev screen size))
             add intin(meta yh(prev screen size))
             do gem
          finish
       end

       routine Redirect Stdout To NUL
          own integer Initialised Descriptors = 0

          if Initialised Descriptors = 0 start
             Initialised Descriptors = 1
             Nul File Descriptor = Imp Creat("NUL", Open Mode Write)
             if Nul File Descriptor <= 0 start
                Select Output(0)
                Print String("Error opening NUL: is ".I To S(Errno, 0).Snl)
                stop
             finish
             !
             ! take note of original screen file handle before it is redirected
             !
             Regs_Ah <- Dos Fn Duplicate a File Handle
             Regs_Bx <- 1
             Int86(Dos Int Function Request, Regs)
             Screen File Descriptor = Regs_AX
          finish
          Regs_Ah <- Dos Fn Force a Duplicate of a Handle
          Regs_Bx <- Nul File Descriptor
          Regs_Cx <- 1
          Int86(Dos Int Function Request, Regs)
       end

       GEM Version = Env Integer("GEM", "VER_NO", 1)
       if Initialised Edwin # 0 and Dev = 'D' start
          Max X = Win X
          Max Y = Win Y
          return
       finish
       if Dev = 'G' start    {trying to produce a metafile}
          !
          ! remember previous values
          !
          Prev Screen Size = Screen Aspect Ratio
          Prev Mouse Addr = Mouse Addr
          Prev Dev = Current device
          Prev Handle = Gem_Contrl_Handle
          Current Device = Metafile Device
       else
          Current Device = Screen Device
          !
          ! First thing to do is to disable control c interrupts because
          ! gem doesn't start up again after a control c interrupt
          !
          *MOVD_#31,R0
          *SVC
          !
          Redirect Stdout To NUL  {so the ^C doesn't get echoed to the screen}
          !                       {and mess up the display}
       finish
       Initialised Edwin = 1
       Initialise Gem
       Open Screen
       Read Environment For(Fname)

       Current_Raster Op  = Replace Mode  {This is how EDWIN will be started up}
       Current_Colour     = Default
       Current_Fill Mode  = Outline
       Current_Line Style = Normal Lines
       Edwin Clear
    end

    predicate Environment Changed
       true if Current_Char Size  # Actual_Char Size
       true if Current_Colour     # Actual_Colour
       true if Current_Fill Mode  # Actual_Fill Mode
       true if Current_Line Style # Actual_Line Style
       true if Current_Raster Op  # Actual_Raster Op
       false
    end

    routine Implement Environment

       routine Set Char Size
          Actual_Char Size = Current_Char Size
          Gem Command(Set Character Height Points Mode)
          Add Intin(Current_Char Size)
          Do Gem
          Letter X   = Pts Out(0)
          Letter Y   = Pts Out(1)
          Char X     = Pts Out(2)
          Char X     = (Char X*4)//5 if GEM Version = 3 and Current Text Face # 1
          Char Y     = Pts Out(3)
          Off Y      = Char Y-Letter Y+1
          Char Fixed = 1
       end

       routine Set Colour
          integer Colour = Current_Colour

          Actual_Colour = Current_Colour
          Colour = 1 if Colour > Real Colours-1
          Gem Command(Set Fill Colour Index)
          Add Intin(PMap(Colour))
          Do Gem
          Gem Command(Set Text Colour Index)
          Add Intin(PMap(Colour))
          Do Gem
          Gem Command(Set Polyline Colour Index)
          Add Intin(PMap(Colour))
          Do Gem
       end

       routine Set Fill Style
          constant integer Max Mode = 15
          integer Mode = Current_Fill Mode
          integer i

          Actual_Fill Mode = Current_Fill Mode
          Mode = 1 if Mode > Max Mode
          Gem Command(Set Fill Interior Style)
          if Mode > 1 start
             Add Intin(4)
             Do Gem
             Gem Command(Set User Defined Fill Pattern)
             Add Intin(Hatch Bitmap(Mode*16 + i)) for i=0, 1, 15
          else
             Add Intin(Mode)
          finish
          Do Gem
       end

       routine Set Line Style
          Actual_Line Style = Current_Line Style
          Gem Command(Set User Defined Line Style Pattern)
          Add Intin(Line Map(Current_Line Style))
          Do Gem
       end

       routine Set Write Mode
          constant integer array Op Map(Replace Mode: Invert Mode) = 1,4,2,3,3

          Actual_Raster Op = Current_Raster Op
          Gem Command(Set Writing Mode)
          Add Intin(Op Map(Current_Raster Op))
          Do Gem
       end

       routine Set Perimeter
          Gem Command(Set Fill Perimeter Visibility)
          if (Current_Raster Op = Replace Mode or
               Current_Raster Op = Or Mode) and
               Current_Colour # 0 start
             Add Intin(1)
          else
             Add Intin(0)
          finish
          Do Gem
       end

       Set Char Size  unless Current_Char Size  = Actual_Char Size
       Set Colour     unless Current_Colour     = Actual_Colour
       Set Fill Style unless Current_Fill Mode  = Actual_Fill Mode
       Set Line Style unless Current_Line Style = Actual_Line Style
       Set Write Mode unless Current_Raster Op  = Actual_Raster Op
       Set Perimeter
    end

    routine do line
       integer i

       return if Pts = 0
       Gem Command(Polyline)
       Add Ptsin(Line X(i), Line Y(i)) for i=0, 1, Pts-1
       Do Gem
       Pts = 0
    end

    routine Flush Line

       Do Line
       Implement Environment if Environment Changed
    end

    routine Flush Environment

       return unless Environment Changed
       Do Line
       Implement Environment
    end

    external routine Edwin Update alias "EDWIN_DD_UPDATE"

       Flush Line
       return if Current Device = Metafile Device
       Gem Command(Update Workstation)
       Do Gem
    end

    external routine Edwin Rectangle alias "EDWIN_DD_RECT"(integer LX,LY,HX,HY)

       Flush Environment
       Gem Command(GDP)
       Gem_Contrl_Sub Function = Bar
       Add Ptsin(LX, LY)
       Add Ptsin(HX, HY)
       Do Gem
    end

    external routine Edwin Clear alias "EDWIN_DD_CLEAR"
       record(Environment Fm) Copy = Current

       return if Current Device # Screen Device
       Flush Line
       Edwin Fill(Solid)
       Edwin Mode(Replace Mode)
       Edwin Colour(Background)
       Edwin Rectangle(0, 0, Win X, Win Y)
       Current = Copy
    end

    external routine edwin dot alias "EDWIN_DD_DOT"(integer X, Y)

       Flush Environment
       Gem Command(Polymarker)
       Add Ptsin(X, Y)
       Do Gem
    end

    external routine Edwin Line alias "EDWIN_DD_LINE"(integer OX, OY, NX, NY)

       routine Start Line
          Line X(0) = OX
          Line Y(0) = OY
          Line X(1) = NX
          Line Y(1) = NY
          Pts = 2
       end

       Flush Environment
       unless Pts = 0 start
          if Line X(Pts-1)=OX and Line Y(Pts-1)=OY and Pts<Max Vertices start
             Line X(Pts) = NX
             Line Y(Pts) = NY
             Pts = Pts+1
          else if Line X(Pts-1)=NX and Line Y(Pts-1)=NY and Pts<Max Vertices
             Line X(Pts) = OX
             Line Y(Pts) = OY
             Pts = Pts+1
          else
             Flush Line
             Start Line
          finish
       else
          Start Line
       finish
    end

    external routine Edwin Polygon alias "EDWIN_DD_POLY"-
                                    (integer Count, integer array name XS, YS)
       integer Seg = Count, Last Seg = 1, i

       Flush Environment
       Seg = Max Vertices if Seg > Max Vertices
       cycle
          if Current_Fill Mode = Outline or Count > Max Vertices start
             Gem Command(Polyline)
          else
             Gem Command(Filled Area)
          finish
          Add Ptsin(XS(i), YS(i)) for i=Last Seg, 1, Seg
          Do Gem
          exit if Seg = Count
          Last Seg = Seg
          Seg = Seg+Max Vertices-1
          Seg = Count if Seg>Count
       repeat
    end

    external routine Edwin Circle alias "EDWIN_DD_CIRCLE"(integer X, Y, Rad)

       Flush Environment
       Gem Command(GDP)
       Gem_Contrl_Sub Function = Circle
       Add Ptsin(X, Y)
       Add Ptsin(0, 0)
       Add Ptsin(Rad,0)
       Do Gem
    end

    external routine Edwin Text alias "EDWIN_DD_TEXT" -
                                 (integer SX, SY, byte name Ch)

       integer Len = C Length(Ch)

       integer function Physical Width(byte name Ch)
          Gem Command(Inquire Text Extent)
          Add String(Ch)
          Do Gem
          result = Pts Out(4)
       end

       Flush Environment
       if Ch = Extents Flag start
          Ch == Byte(Addr(Ch)+1)
          Len = Len-1
          Char X = 0
          cycle
             Char X = Char X+Physical Width(Ch)
             exit unless Len > Max Ints
             Ch == Byte(Addr(Ch)+Max Ints)
             Len = Len-Max Ints
          repeat
       else
          cycle
             Gem Command(Text)
             Add Ptsin(SX, SY)
             Add String(Ch)
             Do Gem
             exit unless Len > Max Ints
             Ch == Byte(Addr(Ch)+Max Ints)
             SX = SX + Physical Width(Ch)
             Len = Len-Max Ints
          repeat
       finish
    end

    external routine Edwin Char Size alias "EDWIN_DD_CHAR"(integer Size)
       return unless Variable Char Size = 1
       Current_Char Size = (Size*Screen Aspect Ratio)//100
    end

    external routine Edwin Line Style alias "EDWIN_DD_STYLE"(integer Style)
       Current_Line Style = Style
    end

    external routine Edwin Colour alias "EDWIN_DD_COL"(integer Colour)
       Current_Colour = Colour
    end

    external routine Edwin Mode alias "EDWIN_DD_MODE"(integer Mode)
       Current_Raster Op = Mode
    end

    external routine Edwin Fill alias "EDWIN_DD_FILL"(integer Mode)
       Current_Fill Mode = Mode
    end

    routine Get Input(integer name State, X, Y, integer Req)
       own integer Last X = 500, Last Y = 400, Last Button = 0
       integer Key

       signal 14, 6 if Current Device # Screen Device
       Flush Line
       Cursor Status(Show Cursor)
       cycle
          Key = Top Of Buffer        {read type ahead before looking for new stuff}
          Key = BDos(Dos Fn Direct Console IO, 255) if Key < 0
          if Key = Escape Char start
             Int Flag = 1
             Key = 0
          finish
          Gem Command(Sample Mouse Button State)
          Do Gem
          Key = 1 if Last Button = 0 and Int Out(0) # 0
          Last Button = Int Out(0)
       repeat until Key # 0 or Req = 0
       Last X = Pts Out(0)
       Last Y = Pts Out(1)
       State = Key                     {input from the keyboard}
       State = 4 if Int Out(0) = 1    {left button}
       State = 1 if Int Out(0) = 2    {middle button}
       State = 2 if Int Out(0) = 4    {right button}
       X = Last X
       Y = Win Y-Last Y
    end

    external routine Sample alias "EDWIN___B_SAM"(integer name state,x,y)
       Get Input(State, X, Y, 0)
    end

    external routine Cursor alias "EDWIN___B_REQ"(integer name state,x,y)
       Get Input(State, X, Y, 1)
    end

    external routine edwin term alias "EDWIN_DD_TERM"
       record(Int Regs Fm) Regs=0
       short mouse segment,mouse offset

       return if initialised edwin=0
       flush line
       gem command(close workstation)
       do gem
       if prev dev=0 start
          initialised edwin=0
          prev dev=0
          prev handle=0
          gem_contrl_handle=0
          current device=0
          Regs_Ah <- Dos Fn Force a Duplicate of a Handle
          Regs_Bx <- screen file descriptor
          Regs_Cx <- 1
          Int86(Dos Int Function Request,Regs)
       else
          current device=prev dev
          prev dev=0
          gem_contrl_handle=prev handle
          prev handle=0
          !
          ! put back all the old defaults
          !
          gem command(extended inquire)
          add intin(0)  ;! get the open workstation values
          do gem
          Winx=intout(0)
          Winy=intout(1)
          real colours=intout(13)
          current_char size=0
          mouse addr=prev mouse addr
          fr86(mouse addr,original byte,1)
          screen aspect ratio=prev screen size
       finish
    end

    {##############################################}
    {#                                            #}
    {#       SCRDRIVE package support             #}
    {#                                            #}
    {##############################################}

    own integer Graphics Mode = 0
    own integer Graphics Offset = 0

    external routine Set Up Scrdrive alias "SET_SCRD"
       Edwin Fill(1)
       Cur X = 0
       Cur Y = 0
       Max X = (Win X//Char X) - 1
       Max X = 250 if Max X > 250
       Max Y = (Win Y//CharY) - 1
       Max Y = 250 if Max Y > 250
       Graphics Offset = (Char Y//10) + 1
    end

    external routine Init Screen alias "InitScreen"(integer X, Y)
       ! ignore parameters to begin with. May contain data about window
       ! sizing and positioning
       !
       Edwin Initialise(Cur X, Cur Y, 'D')
       Set Up Scrdrive
    end

    external routine Kill Window alias "KillWindow"
       Edwin Term
       Initialised Edwin = 0
    end

    external integer function TT Get alias "TTGet"
       integer Char

       Char = Top Of Buffer
       Char = BDos(Dos Fn Console Input Without Echo, 0) if Char < 0
       result = US if Char = 0
       result = Char
    end

    external integer function X TT Get alias "EDWIN_SCREEN_TTGET"
       result = TT Get
    end

    external routine Move To alias "MoveTo"(integer X, Y)
       if X > Max X then X = Max X else if X < 0 then X = 0
       if Y > Max Y then Y = Max Y else if Y < 0 then Y = 0
       Cur X = X
       Cur Y = Y
    end

    external routine X Move To alias "SCR_MOVE_TO"(integer X, Y)
       Move To(X, Y)
    end

    external routine Down Line alias "DownLine"
       Cur Y = Cur Y+1 if Cur Y < Max Y
    end

    external routine Up Line alias "UpLine"
       Cur Y = Cur Y-1 if Cur Y > 0
    end

    external routine Home alias "Home"
       Cur X = 0
       Cur Y = 0
    end

    routine Graphic Chars(byte name C String)
       integer C Ptr, End X

       routine Vertical Line(integer X, Y)
          X = X*Char X + Char X//2
          Y = Y*Char Y
          Edwin Line(X, Y+Graphics Offset, X, Y+Char Y-Graphics Offset)
       end

       routine Glitch(integer X, Y)
          X = X*Char X + Char X//2
          Y = (Y+1)*Char Y
          Edwin Line(X, Y-Graphics Offset, X, Y-Char Y//2)
       end

       return if Graphics Mode = 0
       if C Length(C String) < 2 start
          End X = (Cur X+1)*Char X        {Overwriting current cursor position}
       else
          End X = Win X                   {Overwriting to end of line}
       finish
       Edwin Mode(Replace Mode)
       Edwin Colour(Background Col)
       Edwin Rectangle(Cur X*Char X, Cur Y*Char Y + (Graphics Offset-1),
                       End X, (Cur Y+1)*Char Y - (Graphics Offset-1))
       Edwin Colour(Foreground col)
       Edwin Line(Cur X*Char X, Cur Y*Char Y + Char Y//2,
                  End X, Cur Y*Char Y + Char Y//2)
       C Ptr = Addr(C String)
       cycle
          if C String = 'w' start
             Glitch(Cur X, Cur Y)
          else if C String # 'q'
             Vertical Line(Cur X, Cur Y)
          finish
          C Ptr = C Ptr+1
          Cur X = Cur X+1
          C String == Byte(C Ptr)
       repeat until C String = 0
    end

    external routine TT String alias "TTString"(byte name s)
       integer a=addr(s),i=addr(s),j
       integer len=clength(s)
       integer sx=cur x*char x
       integer sy=(cur y+1)*char y-OffY

       Flush Environment
       Gem Command(Set Writing Mode)
       Add Intin(1)          {make sure it's replace mode}
       Do Gem
       if Graphics Mode=1 and not ('a'<=s<='z') start
          ! not graphics characters, so print them out
          a=a+1 while not ('a'<=byte(a)<='z')
          !
          ! print out the characters
          !
          gem command(text)
          add ptsin(sx,sy)
          add intin(byte(j)) for j=i,1,a
          do gem
          curx=curx+a-i
          Graphic Chars(byte(a))
       else if Graphics Mode=1
          Graphic Chars(s)
       else
          Edwin Colour(Text Col)
          Edwin Text(sx,sy,s)
          move to(curx+len,cury)
       finish
    end

    external routine TT Put alias "TTPut"(integer x)
       byte array cstr(0:1)

       if x=8 start     {backspace}
          move to(curx-1,cury) if CurX>0
          return
       finish
       cstr(0)=x
       cstr(1)=0
       ttstring(cstr(0))
    end

    external routine XTTPut alias "TTPUT"(integer X)
       TT Put(X)
    end

    routine Scr Cursor
       integer x,y

       x=cur x*char x
       y=(cur y+1)*char y
       Edwin Fill(1)
       Edwin Mode(4)
       Edwin Rectangle(x,y,x+letterx,y-chary)
       Edwin Mode(Replace Mode)
    end

    external routine Draw Cursor alias "DrawCursor"
       Scr Cursor
    end

    external routine Delete Cursor alias "DeleteCursor"
       Scr Cursor
    end

    external routine Rectangle alias "Rectangle"(integer X, Y, W, H)
       record(Environment Fm) Copy = Current

       Edwin Mode(Replace Mode)
       Edwin Fill(4)
       Edwin Colour(Foreground Col)
       Edwin Rectangle(X, Y+Off Y, X+W-1, Y+Off Y+H)
       Current = Copy
    end

    external routine Draw Line alias "DrawLine"(integer X, Y, X1, Y1)
       record(Environment Fm) Copy = Current

       Edwin Mode(Replace Mode)
       Edwin Fill(1)
       Edwin Colour(Foreground Col)
       Edwin Line(X, Y+Off Y, X1, Y1+Off Y)
       Current = Copy
    end

    routine Draw Dotted Line (integer X, Y1, Y2, Style)
       record(Environment Fm) Copy = Current

       Edwin Line Style(Style)
       Edwin Mode(3)
       Edwin Line(X, Y1+Off Y, X, Y2+Off Y)
       Edwin Update
       Current = Copy
    end

    external routine Draw Cursor Line alias "Draw_C_L"(integer X, Y1, Y2)
       Draw Dotted Line(X, Y1, Y2, 4)
    end

    external routine Draw Marker Line alias "Draw_M_L"(integer X, Y1, Y2)
       Draw Dotted Line(X, Y1, Y2, 3)
    end

    external routine Flush Output alias "FlushOutput"
       Edwin Update
    end

    external routine Clear Screen alias "ClearScreen"
       Edwin Clear
    end

    routine Clear Space(integer Y1, Y2)
       record(Environment Fm) Copy = Current

       Edwin Fill(1)
       Edwin Colour(Background Col)
       Edwin Mode(Replace Mode)
       Edwin Rectangle(0, Y1*Char Y, Win X, Y2*Char Y)
       Current = Copy
    end

    external routine Clear Line alias "ClearLine"
       Clear Space(Cur Y, Cur Y+1)
    end

    external routine Scroll alias "Scroll"(integer LLn, HLn, By)
       record(Environment Fm) Copy = Current
       integer Erase Line

       Gem Command(Copy Raster Opaque)
       Gem_Contrl_C(7)  <- MFDB Log & 16_FFFF
       Gem_Contrl_C(8)  <- MFDB Log >> 16
       Gem_Contrl_C(9)  <- MFDB Log & 16_FFFF
       Gem_Contrl_C(10) <- MFDB Log >> 16
       Add Intin(3)                             {Replace what is there}
       HLn = HLn+1
       if By < 0 start
          Add Ptsin(0,     (LLn-By)*Char Y)
          Add Ptsin(Win X, HLn*Char Y)
          Add Ptsin(0,     LLn*Char Y)
          Add Ptsin(Win X, (HLn+By)*Char Y)
          Erase Line = HLn
       else
          Add Ptsin(0,     LLn*Char Y)
          Add Ptsin(Win X, (HLn-By)*Char Y)
          Add Ptsin(0,     (LLn+By)*Char Y)
          Add Ptsin(Win X, HLn*Char Y)
          Erase Line = LLn
       finish
       Do Gem
       Clear Space(Erase Line, Erase Line+By)
       Edwin Colour(ForegroundCol)
    end

    external routine Scroll Up alias "ScrollUp"(integer N)
       Scroll(0, Max Y, -N)
    end

    external routine Scroll Down alias "ScrollDown"(integer N)
       Scroll(0, Max Y, N)
    end

    external routine Set Intensity alias "SetIntensity"(integer LoHi)
       own integer Highlight = 0,
                     Hold Colour,
                     Foregroundsave,
                     Textsave

       return if LoHi = Highlight
       Highlight = LoHi
       Gem Command(Set Graphic Text Special Effects)
       Add Intin(LoHi)
       Do Gem
       if LoHi = 1 start
          Hold Colour = Current_Colour
          Edwin Colour(Highlight Col)
          Foregroundsave = ForeGroundCol
          Textsave = TextCol
          TextCol = HighlightCol
          ForeGroundCol = HighlightCol
       else
          Edwin Colour(Hold Colour)
          ForeGroundCol = Foregroundsave
          TextCol = Textsave
       finish
    end

    external routine X Set Intensity alias "SCR_SET_INTENSITY"(integer LoHi)
       Set Intensity(LoHi)
    end

    external routine Set Graphics alias "SetGraphics"(integer Mode)
       Graphics Mode = Mode
    end

    !  Revision:

    !  Rev   1   11/11/86   UJ    1)   Proportionally spaced text is now
    !                                  produced by this device driver. A
    !                                  software font is now used in place
    !                                  of the original, fixed font.
    !                             2)   Text sizing is carried out to the
    !                                  nearest multiple of the basic text
    !                                  size. The sizing info. is held in
    !                                  /lbin/llenv.d, in LL_CHAR_HEIGHT.

    !  Rev   2   18/11/86   UJ         The fill paterns produced by this
    !                                  driver can be the standard Versatec
    !                                  patterns if the Env variable
    !                                  LL_POLY_FILL exists. If it names a file
    !                                  containing 14 16x16 bitmaps arranged as
    !                                  16 integers, then this will be used to
    !                                  define the fill patterns.

    !  Rev   3              UJ         EDWIN line drawing routine modified so
    !                                  that individual lines are compiled into
    !                                  polylines in order to save on metafile
    !                                  space.

    !  Rev   4              UJ         Character sizing can be varied through
    !                                  EDWIN if the environmental variable
    !                                  <filename>_VAR_CHAR_SIZE exists. Initial
    !                                  character size is set with the variable
    !                                  <filename)_CHAR_SIZE. If the proportional
    !                                  text is not wanted, the variable
    !                                  <filename>_FIXED_FONT should exist.

    !  Rev   4              UJ         The environmental variables RED___INTENSITY
    !                                  GREEN_INTENSITY and BLUE__INTENSITY define
    !                                  the colour map for the device. Digit values
    !                                  should be 0-3.

    !  Rev   5              UJ         Whole module tidied up in order to speed
    !                                  up execution and reduce code size.

    !  Rev   6   23/06/88   IRG        Added routine Draw Marker Line
    !

    ! Rev    7    5/08/88   AET        Added code for colour control

    ! Rev    8   20/oct/88  JGH        Removed minimium char size test
    !                                  Removed suppression of variable line styles

    ! Rev    9   16/Jan/89  JGH        Fixed code for Sample, no longer same as REQ!
    end of file