! EDWIN driver for VAX GPX screen.
!
! 002  9-Jan-89 AET Made changes for DRAFT screen refresh and text sizes
! 001 10-May-88 ANY fixed Line Style invalid value bug
! 000 05-May-88 AET modified the way key events are used

from Edwin include Device, Specs, Icodes
from IMP include Ascii, DSC DEF, Lognames, Maths, AST, processes
include UISENTRY,UISUSRDEF,UISMSG
external string (31) spec Fname, Version, Release, Revision
external byte spec Imp Int Flag alias "IMP___INT_FLAG"
external integer spec Font Width alias "CharX"
external integer spec Font Height alias "CharY"
external integer spec Font Descender alias "OffY"

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

external routine spec User Refresh     {Specify your own and it does it too }  
external routine spec Disable UIS Display List Addition
external routine spec Disable UIS KB AST
external routine spec Enable  UIS KB AST

record format List Fm (integer zero,real one,integer two,real three,
                        integer four)
own record (List Fm) WinPos
const integer MaxCount = 512,No=0,Yes=1

!%const %real Lo = 0.75,Hi=1
! Imp compiler does not allow you to initialise own real arrays with 
! const reals            Curse you Ian!

own string (255) Title String = "Edwin VAX UIS Window"
own string (255) Text Font File, Fill Pattern File
own integer array name Edwin Colours 
own integer array EightCols (0:7) = 0,7,4,1,2,6,3,5
own real array Eight Cols R(0:7) = 0,0,0.75,0.75,0,0,0.75,0.75
own real array Eight Cols G(0:7) = 0,0.75,0,0.75,0,0.75,0,0.75
own real array Eight Cols B(0:7) = 0,0,0,0,0.75,0.75,0.75,0.75
own integer array Sixteen Cols (0:15) = 0,15, 4, 1, 2, 6, 8, 5,
                                           3, 7, 9,10,11,12,13,14
own real array Sixteen Cols R(0:15) = 0,0,0.75,0.75,0,0,0.75,0.75,
                                        0,0,1,1,0,0,1,1
own real array Sixteen Cols G(0:15) = 0,0.75,0,0.75,0,0.75,0,0.75,
                                        0,1,0,1,0,1,0,1
own real array Sixteen Cols B(0:15) = 0,0,0,0,0.75,0.75,0.75,0.75,
                                        0,0,0,0,1,1,1,1
own integer name Integer Blank == 0
own real name Real Blank == 0
own  record (DSC FM) name Descriptor Blank == 0
own record(AST FM) name AST Blank == 0
own real Real Zero = 0 
own integer Integer Zero=0,
              VD ID = 0,
              WD ID,
              KB ID,
              Virtual Colour Map,
              TEXT ATB=1,
              GRAPH ATB=2,
              Shade Mode=Patt C Foreground,
              Current Writing Mode=0,
              Char Quality=0,
              Drawing Mode=0,
              Count=0,
              Dummy,
              Colour=1,
              One=1,
              Screen Type,
              Colour Indices,
              Number of Colours,
              rbits,gbits,bbits,
              ibits,res indices,vcm size,
              hibernating = no,
              sampling=no,
              requesting=no,
              Last Input = 0,
              Old Sample x = 0,
              Old Sample y = 0,
              KB Enabled = No
own integer Draft Redraw = 0

own integer name VCM ID
own real Screen Width,Screen Height,x1,y1,x2,y2,Char Height,Char Rot=0
own real xtemp,ytemp
own real Char Slant = 0,Aspect Ratio,rx1,ry1,rx2,ry2,Char Size=12
own integer Xpix,YPix,Lx,Ly
own integer XL = 0
own integer XR = 511     { Right hand side of device window
own integer YB = 0
own integer YT = 511
own real VXMax,VYMax,Window Width,Window Height,CX=0,CY=0,resolx,resoly
own string(255) Device Name = "SYS$WORKSTATION"
own record (DSC FM) Devnam

external routine VAX UIS  alias "EDWIN___C" (integer COM, X, Y)
   switch SW(0:Max Com)
   own real array XPoints (1:MaxCount)
   own real array YPoints (1:MaxCount)
   own integer array Shades (1:10) = Patt C Foreground,
                                        Patt C Horiz1 3,
                                        Patt C Vert1 3,
                                        Patt C Downdiag1 3,
                                        Patt C Updiag1 3,
                                        Patt C Basket Weave, {cross hatch}
                                        Patt C Grid4,
                                        Patt C Grey1 16, {stipple}
                                        Patt C Grid8,    {Checker board}
                                        Patt C Brick Horiz
   own integer array Line Style (0:4) = 16_FFFFFFFF,
                                           16_AAAAAAAA,
                                           16_FFCCFFCC,
                                           16_FFF6FFF6,
                                           16_FFF0FFF0
   own integer array Colour Modes (0:4) = UIS C MODE REPL,
                                             UIS C MODE BICN,
                                             UIS C MODE OVER,
                                             UIS C MODE COMP,
                                             UIS C MODE XOR
   own string(255) Text String = ""

   const integer Max Font=28
   ownstring(31)array Fonts(0:MaxFont)="",
                                         "DTABER0003WK00PG0001UZZZZ02A000",
                                         "DTABER0I03WK00GG0001UZZZZ02A000",
                                         "DTABER0M03CK00GG0001UZZZZ02A000",
                                         "DTABER0R03WK00GG0001UZZZZ02A000",
                                         "DTABER0R07SK00GG0001UZZZZ02A000",
                                         "DTERMING03CK00PG0001UZZZZ02A000",
                                         "DTERMINM06OK00PG0001UZZZZ02A000",
                                         "DTABER0003WK00GG0001UZZZZ02A000",
                                         "DTABER0G03CK00GG0001UZZZZ02A000",
                                         "DTABER0I03WK00PG0001UZZZZ02A000",
                                         "DTABER0M06OK00GG0001UZZZZ02A000",
                                         "DTABER0R03WK00PG0001UZZZZ02A000",
                                         "DTABER0R07SK00PG0001UZZZZ02A000",
                                         "DTERMINM03CK00PG0001UZZZZ02A000",
                                         "DVWSVT0G03CK00GG0001QZZZZ02A000",
                                         "DVWSVT0G03CK00PG0001QZZZZ02A000",
                                         "DVWSVT0I03WK00GG0001QZZZZ02A000",
                                         "DVWSVT0I03WK00PG0001QZZZZ02A000",
                                         "DVWSVT0N03CK00GG0001QZZZZ02A000",
                                         "DVWSVT0N03CK00PG0001QZZZZ02A000",
                                         "DVWSVT0N06OK00GG0001QZZZZ02A000",
                                         "DVWSVT0N06OK00PG0001QZZZZ02A000",
                                         "DVWSVT0R03WK00GG0001QZZZZ02A000",
                                         "DVWSVT0R03WK00PG0001QZZZZ02A000",
                                         "DVWSVT0R07SK00GG0001QZZZZ02A000",
                                         "DVWSVT0R07SK00PG0001QZZZZ02A000",
                                         "DVWSVT1G03CK00GG0001UZZZZ02A000",
                                         "DVWSVT1I03WK00GG0001UZZZZ02A000"


   own record (DSC FM) Title,Text Font,Shade Patterns,space
   routine Get Size (string (127) Value, real name Thing, real default)
      string (127) T Value
      on 3,4,9 start
         Oper Message ("Invalid setting for ".Value)
         signal 14, 1
      finish
      TValue = Translate (Value)
      Thing = Default and return if TValue = Value
      Thing = S to I (TValue) / 10
   end

   own integer Retstate,Dummy,Buttonstate, Counter=0, temp x, temp y
   own record (AST Fm) name Pointer AST,Button AST
   routine BTN AST (integer Dummy)
      integer Temp, Font
      const byte array Button Map (0:3) = 4,1,2,8
      const byte array Button State Map (0:15)= 0,0,0,0,
                                                   0,0,0,8,
                                                   0,0,0,4,
                                                   0,1,2,0
 
      if UIS Get Buttons(WD ID, Buttonstate) start
         Temp  = Button Map (Retstate & 2_11)
         if ButtonstateMap(Buttonstate & 2_1111)= Temp start
             Last Input = Temp
             if UIS Get Pointer Position(VD ID,WD ID,xtemp,ytemp) start
                Old Sample X = Trunc(Xtemp)
                Old Sample Y = Trunc(Ytemp)
             finish
             if sampling = yes or requesting = yes start
                if Hibernating = Yes then Dummy = Wake(0,"")   
                Hibernating = No
                Sampling = No
                Requesting = No
             finish
         finish
      finish

   end

   routine PTR AST (integer Dummy)
      if Sampling = Yes start
         if UIS Get Pointer Position(VD ID,WD ID,xtemp,ytemp) start
            Old Sample X = Trunc(Xtemp)
            Old Sample Y = Trunc(Ytemp)
         finish
         if Hibernating = Yes then Dummy = Wake(0,"")   
         Sampling = No
         Requesting = No
         Hibernating = No
      finish
   end

   routine FIX ASTS
      Button AST == New AST 1(BTN AST)
      UIS Set Button AST(VD ID,WD ID,Button AST,AST Blank,retstate,
                         Real Blank,Real Blank,
                         Real Blank,Real Blank)
      Pointer AST == New AST 1(PTR AST)
      UIS Set Pointer AST(VD ID,WD ID,Pointer AST,AST Blank,
                         Real Blank,Real Blank,
                         Real Blank,Real Blank,
                         AST Blank,AST Blank)
   end

   routine Resize Window(integer Dummy)
      real New Aspect Ratio = Window Height/Window Width
      real New VXMax,New VYMax
      integer Font

      if New Aspect Ratio < Aspect Ratio start
         New VXMax=VYMax/New Aspect Ratio
         New VYMax=VYMax
      else
         New VYMax=VXMax*New Aspect Ratio
         New VXmax=VXMax
      finish
      UIS Resize Window (VD ID,WD ID,Real Blank,Real Blank,
                         Real Blank,Real Blank,
                         Real Zero,Real Zero,
                         New VXmax,New VYMax)
      VAX UIS (3, 0, 0) { This will re-size the viewport for EDWIN & clear it }
                        { It also restores the AST's
      if Interrupted start; finish { This makes sure the handler is established }
      Imp Int Flag = 1                { This forces an interrupt to the user
      if Trunc(New VXMax) < 523 start
          Font = 9
          Font Width = 6
      else
          Font = 2
          Font Width = 8
      finish
      Text Font_Pointer = Addr(Fonts(Font))+1
      Text Font_Length  = Length(Fonts(Font))
      UIS Set Font(VD ID,Text ATB,Text ATB,Text Font)
      if Fname = "DRAFT" start
         if Hibernating = Yes start
            User Refresh
         else
            Draft Redraw = 1
         finish
      else
         User Refresh
         if Hibernating = Yes then Dummy = Wake(0,"")   
      finish
   end

   own record(AST FM) name Thingy

   routine Do Polygon
      integer I, Local Count
      ! The reason for Local Count is that Count may be reset by AST Handler
      Local Count = Count
      return if Count <= 2
      if Current Writing Mode = Colour Modes(0) or
          Current Writing Mode = Colour Modes(2) start   

         UIS Line Array (VD ID,Graph ATB,Count,XPoints(1),YPoints(1))
      finish
      for I = 2,2,Local Count cycle
         XPoints(I//2) = XPoints(I)
         YPoints(I//2) = YPoints(I)
      repeat
      Local Count = Local Count//2
      UIS Plot Array (VD ID, Graph ATB, Local Count, XPoints(1), YPoints(1))
      Count = 0
   end

   routine Flush Lines
      return if Count = 0
      UIS LINE ARRAY (VD ID,GRAPH ATB,Count,XPoints(1),YPoints(1))
      Count = 0
   end

   routine Flush Text
      real  XPos,YPos
      record(DSC FM) Text
      if Text String # "" start
         XPos=CX
         YPos=CY
         Text_Pointer=Addr(Text String)+1
         Text_Length=Length(Text String)
         Text_DType = DSC DTYPE T
         UIS Set Position(VD ID,XPos,YPos)         
         UIS Text (VD ID,Text Atb,Text,Real Blank,Real Blank,
                                       Integer Blank,Integer Blank)
         UIS Get Position(VD ID,XPos,YPos)
         CX = Trunc(XPos);CY=Trunc(YPos)
         Text String=""
      finish
   end


   routine CHANGE ATTRIBUTE (integer WHICH, TO)
      Flush Lines;Flush Text
      switch AS(0:ATT MAXIMUM)
      -> AS(WHICH)
   
AS(att colour):
      Colour=To
      if Screen Type = UIS C DEV Mono start
         if Colour > 1 then Colour = 1
      else
         if Colour >= VCM Size start
            Colour = 1
         finish
         Colour = Edwin Colours (Colour)
      finish
      UIS Set Writing Index(VD ID,Graph Atb,Graph Atb,Colour)
      UIS Set Writing Index(VD ID,Text  Atb,Text  Atb,Colour)
      return

AS(att line style):
      To = 0 unless 0 <= To <= 4
      UIS Set Line Style (VD ID,Graph Atb,Graph Atb,Line Style(To))
      return

AS(att char quality):
      if To > 0 start
         UIS Set Char Size(VD ID,Text ATB,Text Atb,DescriptorBlank,
                             Char Size,Real Blank)
      else
         UIS Set Char Size(VD ID,Text ATB,Text Atb,DescriptorBlank,
                             Real Blank,Real Blank)
      finish
      Char Quality = To
      return

AS(att char size):
      Char Size = To
      if Char Quality > 0 then start
         UIS Set Char Size(VD ID,Text ATB,Text Atb,DescriptorBlank,
                             Char Size,Real Blank)
      finish
      return

AS(att char font):
      while To > MaxFont cycle
         To = To - MaxFont
      repeat
      Text Font_Pointer = Addr(Fonts(To))+1
      Text Font_Length  = Length(Fonts(To))
      UIS Set Font (VD ID,Text Atb,Text Atb,Text Font)
      if Char Quality > 0 then start
         UIS Set Char Size(VD ID,Text ATB,Text Atb,DescriptorBlank,
                             Char Size,Real Blank)
      finish
      return
AS(att char rot):
      x1 = To
      UIS Set Text Slope (VD ID,Text Atb,Text Atb,x1)
      Char Rot = To/DTOR      
      return

AS(att char slant):
      x1 = To
      UIS Set Char Slant (VD ID,Text ATB,Text ATB,x1)
      Char Slant = To/DTOR
      return

AS(att colour mode):
      if To > 4 then To = 0
      To = Colour Modes(To)
      UIS Set Writing Mode(VD ID,Graph Atb,Graph Atb,To)
      UIS Set Writing Mode(VD ID,Text  Atb,Text  Atb,To)
      Current Writing Mode = To
      return

AS(att shade mode):
      if To = 0 start
         UIS Set Fill Pattern(VD ID,Graph Atb,Graph Atb,Integer Blank)
         return
      else if To <= 10 
         Shade Mode = Shades(To)
      else
         Shade Mode = To - 10
         while Shade Mode >= Patt C Max Pattern cycle
            Shade Mode = Shade Mode - Patt C Max Pattern
         repeat
      finish
      UIS Set Fill Pattern (VD ID,Graph Atb,Graph Atb,Shade Mode)
      return

AS(*): ! Ignore all other attributes
   end

   Counter = counter + 1
   if Counter > 100 start
      Last input = 0 and Imp Int Flag = 1 if Last input = Etx or Last input = Del
      Counter = 0
   finish
   -> SW(COM)

SW(0): ! Initialise
      if VD ID = 0 start
         Text Font File = Fonts(2)
         Fill Pattern File = Translate("UIS$FILL_PATTERNS")
         Fonts(0) = Text Font File
         Devnam_Length = Length(Device Name)
         Devnam_Pointer = Addr(Device Name)+1
         Text Font_Length = Length(Text Font File)
         Text Font_Pointer = Addr(Text Font File) + 1
         Shade Patterns_Length = Length(Fill Pattern File)
         Shade Patterns_Pointer = Addr(Fill Pattern File) + 1
         UIS Get Display Size (Devnam,Screen Width,Screen Height,
                               ResolX,ResolY,
                               XPix,Ypix)
         UIS Get HW Color Info (Devnam,Screen Type,Colour Indices,
                                Number of Colours,
                                Integer Blank,
                                rbits,gbits,bbits,
                                ibits,res indices,
                                integer blank)
         VCM ID == Virtual Colour Map
         if Screen Type = UIS C DEV COLOR or
             Screen Type = UIS C DEV INTENSITY start
   !         %if Colour Indices - Res Indices < 16 %start
               VCM SIZE = 8 
   !         %else 
   !            VCM SIZE = 16
   !         %finish
            VCM ID = UIS CREATE COLOR MAP(VCM SIZE,Descriptor Blank,Integer Blank)
         else 
            VCM ID == Integer Blank
         finish
         Aspect Ratio = SQRT(2)/2
         Window Width = Screen Width
         Window Height = Screen Height
         VXMax=Resolx * Window Width
         VYMax=ResolY * Window Height
   
         Get Size ("EDWIN_UIS_LEFT", winpos_one, -1)
         Get Size ("EDWIN_UIS_BOTTOM", winpos_three, -1)
         Get Size ("EDWIN_UIS_WIDTH", Window Width, Window Width)
         Get Size ("EDWIN_UIS_HEIGHT", Window Height, Window Height)
         Title String = Fname." ".Version.".".Release
         Title String = Title String.".".Revision unless Revision = "0"
         Title_Length = Length(Title String)
         Title_Pointer = Addr(Title String)+1
         Winpos_zero = WDPL C ABS POS X
         WINPOS_two = WDPL C ABS POS Y
         Winpos_four = WDPL C END OF LIST
         if winpos_one = -1 or winpos_three = -1 then Winpos_zero = WDPL C END OF LIST
         VD ID = UIS Create Display (Real Zero,Real Zero,VX Max,VY Max,
                                        Window Width,Window Height,VCM ID)
         WD ID = UIS Create Window (VD ID,Devnam,Title,
                                    Real Blank,Real Blank,
                                    Real Blank,Real Blank,
                                    Real Blank,Real Blank,
                                    Winpos_Zero)
      else
         UIS Expand Icon (WD ID, Integer Blank, Integer Blank)
      finish
      FIX ASTS

      if Screen Type = UIS C DEV COLOR or
          Screen Type = UIS C DEV INTENSITY start
!         Changed to use only 8 colours to match intensities of SCRDRIVE
!         %if Colour Indices - Res Indices < 16 %start
            Edwin Colours == EightCols
            Uis Set Colors (VD ID,Integer Zero,VCM Size,
                           Eight Cols R (0), Eight Cols G (0), Eight Cols B (0))
            Dev data_max Colour = 7
!         %else 
!            Edwin Colours == Sixteen Cols
!            Uis Set Colors (VD ID,Integer Zero,VCM Size,
!                    Sixteen Cols R (0), Sixteen Cols G (0), Sixteen Cols B (0))
!         %finish
      finish
      UIS Get Viewport Size (WD ID,Window Width,Window Height)
      Aspect Ratio = Window Height / Window Width
      VX Max = ResolX * Window Width 
      VY Max = ResolY * Window Height
      UIS Move Window (VD ID,WD ID,Real Zero,Real Zero,VX Max,VY Max)
      dev data_Mvx = Trunc(VX Max)
      dev data_Mvy = Trunc(VY Max)
      dev data_dvy = dev data_Mvy
      dev data_dvx = dev data_Mvy
      dev data_name = "a VAX UIS Graphics Window"


      Disable UIS Display List Addition
      UIS Set Font(VD ID,Integer Zero,Graph ATB,Shade Patterns)
      UIS Set Fill Pattern(VD ID,Graph ATB,Graph ATB,Shade Mode)
      UIS Set Font(VD ID,Integer Zero,Text ATB,Text Font)
      UIS Set Char Size(VD ID,Text ATB,Text Atb,Descriptor Blank,Real Blank,
                                      Real Blank)
      
      Thingy  == New AST 1 (Resize Window)
      UIS Set Resize Ast(VD ID,WD ID,Thingy,AST Blank,Real Blank,Real Blank,
                         Window Width,Window Height,
                         Real Blank,real Blank,
                         Real Blank,Real Blank)


      if fname = "DRAFT" start
         Font Width = 8
         Font Height = 16
         Font Descender = 4
         ! enable keypad input
         ttput (27)
         ttput ('=')
         Flush Output
         Enable UIS KB AST
      finish
      Count = 0
      Text String=""
      return

SW(1): !Terminate
      Flush Lines
      Flush Text
      Disable UIS KB AST
      if fname = "DRAFT" start
         ! Disable keypad input
         ttput (27)
         ttput ('>')
         flush output
      finish
!!      UIS Delete Display (VD ID)
      UIS Shrink to Icon (WD ID, Integer Blank, Integer Blank, Integer Blank, Integer Blank)
      return

SW(2): ! Update
      Flush Lines;Flush Text
      return

SW(3): ! New frame
      Count = 0
      Text String=""
      UIS Erase (VD ID,Real Blank,Real Blank,Real Blank,Real Blank)
      Fix ASTs
      UIS Get ViewPort Size (WD ID,Window Width,Window Height)
      Aspect Ratio = Window Height/Window Width
      VX Max = Resolx * Window Width
      VY Max = ResolY * Window Height
      Dev Data_Mvy = Trunc(VY Max)
      Dev Data_Mvx = Trunc(VX Max)
      UIS Move Window (VD ID,WD ID,
                       Real Zero,Real Zero,
                       VX Max,VY Max)
      Viewport (0,Dev Data_Mvx,0,Dev Data_Mvy)
      return

SW(4): ! Move Abs
      Flush Text
      CX = X;CY = Y
      return

SW(5): ! Line Abs
      Count = Count + 1
      XPoints(Count) = CX;YPoints(Count) = CY
      CX = X;CY = Y
      Count = Count+1
      Xpoints(Count) = CX;YPoints(Count) = CY
      if Count = MaxCount start
         if Drawing Mode=3 start
            Do Polygon
         else 
            Flush Lines
         finish
      finish
      return

SW(6): ! Character
       Text String = Text String.X
       return

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

SW(8): ! Lower window bounds
       XL = X;   YB = Y
       return

SW(9): ! Upper window bounds
       XR = X;   YT = Y
       return

SW(10): ! Drawing Mode
       if Drawing Mode = 3 start
         Do Polygon
       else 
         Flush Lines;   Flush Text
       finish
       Drawing Mode=X
       return

SW(11): ! Was overwrite mode
        return

SW(12): ! Lower box bounds
        LX = X;LY = Y
        return

SW(13): ! Upper box bounds
        Flush Lines;Flush Text
        if LX > X then Swap(X,LX)
        if LY > Y then Swap(Y,LY)
        if LX > XR or LY > YT or X < XL or Y < YB then return
        if LX < XL then LX = XL
        if LY < YB then LY = YB
        if X > XR then X = XR
        if Y > YT then Y = YT
        X1 = LX;X2=X;Y1=LY;Y2=Y
        UIS Plot (VD ID,Graph Atb,X1,Y1,X2,Y1,X2,Y2,X1,Y2)
        if Current Writing Mode = Colour Modes(0) or 
            Current Writing Mode = Colour Modes(2) start
           UIS Line (VD ID,Graph Atb,
                     X1,Y1,X2,Y1,
                     X2,Y1,X2,Y2,
                     X2,Y2,X1,Y2,
                     X1,Y2,X1,Y1)
        finish
        return

SW(*):
end

external routine Sample alias "EDWIN___C_SAM" (integer name CH, X, Y)
   if Draft Redraw # 0 start
      User Refresh
      Draft Redraw = 0
   finish
   VAX UIS(2,0,0)
   if Last Input = 0 start
      Sampling = Yes
      Hibernating = Yes
      Hiber
   finish
   x = Old Sample X
   y = Old Sample Y
   CH = Last Input
   Last Input = 0
end

external routine R REQ alias "EDWIN___C_REQ" (integer name CH, X, Y)
   if Draft Redraw # 0 start
      User Refresh
      Draft Redraw = 0
   finish
   VAX UIS(2,0,0)
   if Last Input = 0 start
      Requesting = Yes
      Hibernating = Yes
      Hiber
   finish
   x = Old Sample X
   y = Old Sample Y
   CH = Last Input
   Last Input = 0
end

external integer fn Screen TTget alias "EDWIN_SCREEN_TTGET"
   integer CH
   if Draft Redraw # 0 start
      User Refresh
      Draft Redraw = 0
   finish
   VAX UIS(2,0,0)
   if KB Enabled = No start
      result = TTGET
   else
      if Last Input = 0 start
         Hibernating = Yes
         Hiber
      finish
      CH = Last Input
      Last Input = 0
      result = CH
   finish
end

!%external %routine draw dots %alias  "EDWIN_DRAW_DOTS" ( -
!                 %integer lx,ly,hx,hy,gap)
!   %integer Dummy,temp1,temp2,cx=lx,vlx=lx,vly=ly,vhx=hx,vhy=hy
!   Map To Device Coords(lx,ly)
!   Map To Device Coords(hx,hy)
!! Draw vertical lines in black
!   Vax UIS(7,9,0)
!   Vax UIS(7,0,1) {overwrite black}
!   %own %real rcx,rlx,rly,rhx,rhy,rgap
!   rcx=lx;rlx=lx;rly=ly;rhx=hx;rhy=hy;rgap=gap
!   %own %integer count
!   count = ((vhx-vlx)//gap + 1)*2
!   %if Count<2 %then Count = 2
!   %begin
!      %integer I
!      %own %real %array xpoints (1:2048)
!      %own %real %array ypoints (1:2048)
!      %for I = 1,2,Count-1 %cycle
!         ypoints(I)=rly
!         ypoints(I+1)=rhy
!      %repeat
!      I = 1
!      %while I < Count %cycle
!         Temp1=cx
!         Dummy=0
!         Map To Device Coords(Temp1,Dummy)
!         xpoints(I)=Temp1
!         I = I + 1
!         xpoints(I)=Temp1
!         I = I + 1
!         cx = cx + gap
!      %repeat
!      UIS Line Array (VD ID,Graph Atb,Count,xpoints(1),ypoints(1))
!   %end
!! Draw white horizontal boxes
!   %own %integer cy
!   %own %real rcy,x1,x2,y1,y2   
!   cy=vly
!   Vax UIS(7,10,1) {filled box}
!   Vax UIS(7,0,0) {white or blank}
!   x1=rlx
!   x2=rhx
!   %while cy < vhy %cycle
!      Temp1=cy   
!      Dummy=0
!      Map To Device Coords(dummy,Temp1)
!      y1=Temp1+1
!      Temp1=cy+gap
!      Dummy=0
!      Map To Device Coords(dummy,Temp1)
!      y2=Temp1-1
!      %if y2 > rhy %then y2=rhy
!      UIS Plot(VD ID,Graph Atb,x1,y1,x1,y2,x2,y2,x2,y1)
!      cy = cy + gap
!   %repeat
!   VAX UIS(7,0,1) {black}
!%end
!
!%external %routine set uis title (%string(255) Title)
!   Title String = Title
!%end

external routine Begin UIS Segment (integer name SEG ID)
   SEG ID = UIS Begin Segment(VD ID)
end

external routine End UIS Segment
   VAX UIS(2,0,0) {update}
   UIS End Segment(VD ID)
end

external routine Delete UIS Segment(integer SEG ID)
   own integer Flags=UIS M DL UPDATE WINDOW
   UIS Disable Display List(VD ID,Flags)
   UIS Delete Object(SEG ID)
   UIS Enable Display List(VD ID,Flags)
end

external routine Enable UIS KB AST
   own integer Keybuf
   record (AST FM) name Key AST
   routine KB AST (integer Dummy)
      integer Thing
      Thing=Keybuf & 16_FFFF
      Last Input = Thing
      if Hibernating = Yes then Dummy = Wake(0,"")   
      Hibernating = No
      Requesting = No
      Sampling = No
   end
   return if KB Enabled=Yes
   KB Enabled = Yes
   KB ID = UIS Create KB(devnam)
   uis enable kb(kb id,wd id)
   Key AST == New AST 1(KB AST)
   UIS Set KB AST(KB ID,Key AST,AST Blank,keybuf)
end

external routine Disable UIS KB AST
   return if KB Enabled=No
   KB Enabled=No
   UIS Set KB AST(KB ID,AST Blank,AST Blank,Integer Blank)
   UIS Delete KB(KB ID)
end

external routine Disable UIS Display List Addition
   own integer Flags = UIS M DL ENHANCE LIST
   UIS Disable Display List(VD ID,Flags)
end

external routine Enable UIS Display List Addition
   own integer Flags = UIS M DL ENHANCE LIST
   UIS Enable Display List(VD ID,Flags)
end

end of file