    ! EDWIN driver for the Apollo
    !
    !  Notes and Revision
    !
    !  1. Note that ACQUIRE DISPLAY and RELEASE DISPLAY are always called dirctly
    !     instead of comparing amode with GPR DIRECT always.  Note however that
    !     no status check is carried out afterwards, as it will be # 0 if amode is
    !     not GPR DIRECT.

    !  17-Aug-1988   MM   Extend Mouse Keyset for DRAFT
    !   9-Jan-1988  JGH   Changes to Terminate for iconizing, see SCN 330

    from Edwin include Device, Specs
    from Imp   include Ascii, Lognames
    external byte spec Imp Int Flag alias "IMP___INT_FLAG"
    external string(31) spec fname
    external routine spec User Refresh
    external integer spec Font Width alias "CharX"
    external integer spec Font Height alias "CharY"
    external integer spec Font Descender alias "OffY"

    constant short Max Screen Size = 1280
    constant short gpr bw portrait = 0,
                     gpr bw landscape = 1,
                     gpr color 1024 x 1024 x 4 = 2,
                     gpr color 1024 x 1024 x 8 = 3,
                     gpr color 1024 x 800  x 4 = 4,
                     gpr color 1024 x 800  x 8 = 5,
                     gpr color 1280 x 1024 x 8 = 6,
                     grp color1 1024 x 800 x 8 = 7,
                     grp color2 1024 x 800 x 4 = 8,
                     grp bw     1280 x 1024    = 9,
                     Max Known Type = 9

    constant short gpr borrow = 0,
                     gpr frame = 1,
                     gpr no display = 2,
                     gpr direct = 3,
                     gpr borrow nc = 4

    constant short gpr solid = 0,   gpr dotted = 1

    own short gpr ok if obs = 0,
                gpr error if obs = 1,
                gpr pop if obs = 2,
                block if obs = 3

    own short gpr keystroke = 0,
                gpr buttons = 1,
                gpr locator = 2,
                gpr entered window = 3,
                gpr left window = 4,
                gpr locator stop = 5,
                gpr no event = 6,
                gpr locator update = 7,
                gpr dial = 8

    record format gpr position t     (short x coord, y coord)

    record format gpr offset t       (short x size, y size)

    record format gpr window t       (record (gpr position t) window base,
                                        record (gpr offset t) window size)

    record format gpr horiz seg t    (short x coord l, x coord r, y coord)

    record format gpr trap t         (record (gpr horiz seg t) top, bot)

    external routine spec gpr init alias "GPR_$INIT" ( c
                   short name op,
                   short name unit or pad,
                   record(gpr offset t) name size,
                   short name hi plane,
                   integer name init bitmap,
                   integer name status)

    external routine spec gpr terminate alias "GPR_$TERMINATE" ( c
                   integer name delete disp,
                   integer name status)

    external routine spec gpr set cursor active c
                             alias "GPR_$SET_CURSOR_ACTIVE" ( c
                    integer name active,
                    integer name status)

    external routine spec gpr set cursor origin c
                             alias "GPR_$SET_CURSOR_ORIGIN" (c
                    record(gpr position t) name pos,
                    integer name status)

    external routine spec gpr set cursor position c
                             alias "GPR_$SET_CURSOR_POSITION" (c
                    record(gpr position t) name pos,
                    integer name status)

    external routine spec gpr set cursor pattern c
                             alias "GPR_$SET_CURSOR_PATTERN" (c
                    integer name bitmap desc,
                    integer name status)

    external routine spec gpr allocate bitmap c
                             alias "GPR_$ALLOCATE_BITMAP" (c
                    record(gpr offset t) name size,
                    short   name hi plane,
                    integer name attr,
                    integer name bitmap,
                    integer name status)

    external routine spec gpr set bitmap c
                             alias "GPR_$SET_BITMAP" (c
                    integer name bitmap,
                    integer name status)

    external routine spec gpr deallocate bitmap c
                             alias "GPR_$DEALLOCATE_BITMAP" ( c
                    integer name bitmap,
                    integer name status)

    external routine spec gpr allocate attribute block c
                             alias "GPR_$ALLOCATE_ATTRIBUTE_BLOCK" ( c
                    integer name attrib,
                    integer name status)

    external routine spec gpr deallocate attribute block c
                             alias "GPR_$DEALLOCATE_ATTRIBUTE_BLOCK" ( c
                    integer name attrib,
                    integer status)

    external routine spec gpr set attribute block c
                             alias "GPR_$SET_ATTRIBUTE_BLOCK" ( c
                    integer name attrib,
                    integer name status)

    external routine spec gpr set text font c
                             alias "GPR_$SET_TEXT_FONT" ( c
                    short name font id,
                    integer name status)

    external routine spec gpr set coordinate origin c
                             alias "GPR_$SET_COORDINATE_ORIGIN" ( c
                    record(gpr position t) name origin,
                    integer name status)

    external routine spec gpr set draw value c
                             alias "GPR_$SET_DRAW_VALUE" ( c
                    integer name val,
                    integer name status)

    external routine spec gpr set text value c
                             alias "GPR_$SET_TEXT_VALUE" ( c
                    integer name val,
                    integer name status)

    external routine spec gpr set text background value c
                             alias "GPR_$SET_TEXT_BACKGROUND_VALUE" ( c
                    integer name val,
                    integer name status)

    external routine spec gpr set fill value c
                             alias "GPR_$SET_FILL_VALUE" ( c
                    integer name val,
                    integer name status)

    external routine spec gpr set raster op c
                             alias "GPR_$SET_RASTER_OP" ( c
                    short name plane,
                    short name op,
                    integer name status)

    external routine spec gpr set line pattern c
                             alias "GPR_$SET_LINE_PATTERN" ( c
                    short name repeat,
                    short name pattern,
                    short name length,
                    integer name status)

    external routine spec gpr set linestyle c
                             alias "GPR_$SET_LINESTYLE" ( c
                    short name style,
                    short name scale,
                    integer name status)

    external routine spec gpr inq constraints c
                             alias "GPR_$INQ_CONSTRAINTS" ( c
                    record(gpr window t) name window,
                    integer name active { boolean },
                    short name mask,
                    integer name status)

    external routine spec gpr inq text c
                             alias "GPR_$INQ_TEXT" ( c
                    short name font id,
                    short name path,
                    integer name status)

    external routine spec gpr inq coordinate origin c
                             alias "GPR_$INQ_COORDINATE_ORIGIN" ( c
                    record(gpr position t) name origin,
                    integer name status)

    external routine spec gpr inq draw value c
                             alias "GPR_$INQ_DRAW_VALUE" ( c
                    integer name val,
                    integer name status)

    external routine spec gpr inq text values c
                             alias "GPR_$INQ_TEXT_VALUES" ( c
                    integer name tval,
                                   bval,
                    integer name status)

    external routine spec gpr inq fill value c
                             alias "GPR_$INQ_FILL_VALUE" (c
                    integer name val,
                    integer name status)

    external routine spec gpr inq raster ops c
                             alias "GPR_$INQ_RASTER_OPS" ( c
                    short name ops,
                    integer name status)

    external routine spec gpr inq linestyle c
                             alias "GPR_$INQ_LINESTYLE" ( c
                    short name style,
                    short name scale,
                    integer name status)

    external routine spec gpr inq bitmap dimensions -
                    alias "GPR_$INQ_BITMAP_DIMENSIONS" (-
       integer name Bitmap Desc, record (Gpr Offset T) name Size,
       short name Hi Plane Id, integer name Status)

    external routine spec gpr set bitmap dimensions -
                    alias "GPR_$SET_BITMAP_DIMENSIONS" (-
       integer name Bitmap Desc, record (Gpr Offset T) name Size,
       short name Hi Plane Id, integer name Status)

    external routine spec gpr move alias "GPR_$MOVE" ( c
                    short name x,y,
                    integer name status)

    external routine spec gpr inq cp alias "GPR_$INQ_CP" (c
                    short name x,y,
                    integer name status)

    external routine spec gpr line alias "GPR_$LINE" ( c
                    short name x,y,
                    integer name status)

    external routine spec gpr load font file c
                             alias "GPR_$LOAD_FONT_FILE" ( c
                    byte name pn,
                    short name pnlen,
                    short name font id,
                    integer name status)

    external routine spec gpr unload font file c
                             alias "GPR_$UNLOAD_FONT_FILE" ( c
                    short name font id,
                    integer name status)

    external routine spec gpr text alias "GPR_$TEXT" ( c
                    byte name str,
                    short name strl,
                    integer name status)

    external routine spec gpr inq text extent c
                             alias "GPR_$INQ_TEXT_EXTENT" ( c
                     byte name str,
                     short name strl,
                     record(gpr offset t) name size,
                     integer name status)

    external routine spec gpr inq text offset c
                             alias "GPR_$INQ_TEXT_OFFSET" ( c
                    byte name str,
                    short name strl,
                    record(gpr offset t) name start,
                    short name x end,
                    integer name status)

    external routine spec gpr clear alias "GPR_$CLEAR" ( c
                    integer name val,
                    integer name status)

    external routine spec gpr pixel blt c
                             alias "GPR_$PIXEL_BLT" ( c
                    integer name src b,
                    record (gpr window t) name src w,
                    record (gpr position t) name dst o,
                    integer name status)

    external routine spec gpr bit blt c
                             alias "GPR_$BIT_BLT" ( c
                    integer name src b,
                    record (gpr window t) name src w,
                    short name src p,
                    record (gpr position t) name dst o,
                    short name dst p,
                    integer name status)

    external routine spec gpr additive blt c
                             alias "GPR_$ADDITIVE_BLT" ( c
                    integer name src b,
                    record (gpr window t) name src w,
                    short name src p,
                    record(gpr position t) name dst o,
                    integer name status)

    external routine spec gpr rectangle c
                             alias "GPR_$RECTANGLE" ( c
                    record(gpr window t) name rect,
                    integer name status)

    external routine spec gpr set obscured opt c
                             alias "GPR_$SET_OBSCURED_OPT" ( c
       short name if obscured, integer name status)

    external integer function spec gpr acquire display c
                                       alias "GPR_$ACQUIRE_DISPLAY" ( c
       integer name status)

    external routine spec gpr force release c
                             alias "GPR_$FORCE_RELEASE" ( c
       short name acq rel cnt, integer name status)

    external routine spec gpr release display c
                             alias "GPR_$RELEASE_DISPLAY" ( c
       integer name status)

    external byte function spec gpr event wait c
                            alias "GPR_$EVENT_WAIT" ( c
       short name event type, byte name event data,
       record (gpr position t) name pos, integer name status)

    external byte function spec gpr cond event wait c
                            alias "GPR_$COND_EVENT_WAIT" ( c
       short name event type, byte name event data,
       record (gpr position t) name pos, integer name status)

    external routine spec gpr enable input c
                             alias "GPR_$ENABLE_INPUT" ( c
       short name event type, short name key set, integer name status)

    external routine spec gpr disable input c
                             alias "GPR_$DISABLE_INPUT" ( c
       short name event type, integer name status)

    external routine spec gpr inq cursor c
                             alias "GPR_$INQ_CURSOR" ( c
       integer name cursor pattern, short name raster op, integer name active,
       record(gpr position t) name position, record(gpr position t) name origin,
       integer name status)

    external routine spec gpr set auto refresh c
                              alias "GPR_$SET_AUTO_REFRESH" ( c
        integer name auto refresh, integer name status)

    external routine spec gpr set clip window c
                    alias "GPR_$SET_CLIP_WINDOW" ( c
        record (gpr window t) name window, integer name status)

    external routine spec gpr set clipping active c
                alias "GPR_$SET_CLIPPING_ACTIVE" ( c
        integer name active, integer name status)

    external routine spec gpr polyline c
                      alias "GPR_$POLYLINE" ( c
        short name x,y, short name npoints, integer name status)

    external routine spec gpr pgon polyline c
                    alias "GPR_$PGON_POLYLINE" ( c
       short name x,y, short name npoints, integer name status)

    external routine spec gpr start pgon c
                        alias "GPR_$START_PGON" ( c
                    short name x,y, integer name status)

    external routine spec gpr close fill pgon c
                    alias "GPR_$CLOSE_FILL_PGON" ( c
                    integer name status)

    external routine spec gpr close return pgon tri -
                    alias "GPR_$CLOSE_RETURN_PGON_TRI" ( -
       short name List Size, T List, N Triangles, integer name status)

    external routine spec gpr multitriangle -
                    alias "GPR_$MULTITRIANGLE" ( -
       short name T List, N Triangles, integer name status)

    external routine spec gpr pgon decomp technique -
                    alias "GPR_$PGON_DECOMP_TECHNIQUE" (-
       short name Decomp Technique, integer name Status)

    external routine spec Gpr Set colour map alias "GPR_$SET_COLOR_MAP" ( c
                      integer name index,
                      short name nentries,
                      integer name values,     { dodgy array }
                      integer name status)

    external routine spec Set Plane Mask 32 alias "GPR_$SET_PLANE_MASK_32" ( c
                       integer name mask,
                       integer name status)

    external routine spec Set Fill Pattern alias "GPR_$SET_FILL_PATTERN" ( c
                       integer name pattern,
                       short name scale,
                       integer name status)

    external routine spec Set Line Pattern alias "GPR_$SET_LINE_PATTERN" ( c
                       short name repeat,
                       short name pattern,       { dodgy - array }
                       short name length,
                       integer name status)

    external routine spec Gpr Inq Config alias "GPR_$INQ_CONFIG" ( c
                       short name format,
                       integer name status)

    external routine spec Gpr Circle alias "GPR_$CIRCLE" ( c
                       record(gpr position t) name center,
                       short name radius,
                       integer name status)

    external routine spec Gpr Circle Filled alias "GPR_$CIRCLE_FILLED" ( c
                       record(gpr position t) name center,
                       short name radius,
                       integer name status)

    external routine spec Gpr Draw box alias "GPR_$DRAW_BOX" ( c
                       record(gpr position t) name c1,c2,
                       integer name status)

    external routine spec Gpr Close Return Pgon alias "GPR_$CLOSE_RETURN_PGON" ( c
                       short name list size,
                       record (gpr trap t) name trapesiod list,
                       short name trapesiod number,
                       integer name status)

    external routine spec Gpr Multitrapeziod alias "GPR_$MULTITRAPEZOID" ( c
                       record (gpr trap t) name trapesiod list,
                       short name trapesiod number,
                       integer name status)

    external routine spec Gpr Triangle alias "GPR_$TRIANGLE" (c
                       record (gpr position t) name vertex 1, vertex 2, vertex 3,
                       integer name status)

    ! PAD System services for window control

    constant integer pad transcript = 0,
                       pad input = 1,
                       pad edit = 2,  {already declared}
                       pad read edit = 3

    record format pad window desc t (short top,left,width,height)

    external routine spec pad create window alias "PAD_$CREATE_WINDOW" ( c
                 byte name n,short name l,short name ptype,
                 short name unit,record(pad window desc t) name window,
                 short name rslt stream,
                 integer name status)

    external routine spec Pad Inq Font alias "PAD_$INQ_FONT" (short name -
      stream, width, height, integer name name, short name size, Len,
      integer name status)

    external routine spec Pad Inq Window alias "PAD_$INQ_WINDOWS" (-
       short name stream, short array name list,
       short name size, number, integer name status)

    external routine spec pad make icon alias "PAD_$MAKE_ICON" (c
                 short name Sid, Wid, byte name icon char, integer name status)

    external routine spec pad Select Window alias "PAD_$SELECT_WINDOW" (c
                 short name Sid, Wid, integer name status)

    external routine spec pad set auto close alias "PAD_$SET_AUTO_CLOSE" ( c
                  short name sid, wid, integer name auto close, status)

    external routine spec pad set Icon Font alias "PAD_$SET_ICON_FONT" ( c
                  short name sid, wid,
                  byte name font name,
                  short name font len, integer name status)

    !********************************************************************

    own integer screen width = Max Screen Size, screen height = Max Screen Size
    const integer  ok = 0

    ! Screen information
    own short   SX = 0
    own short   SY = 0
    own integer XL = 0
    own integer XR = Max Screen Size;     !Right hand side of device window
    own integer YB = 0
    own integer YT = Max Screen Size
    own short   raster op = 3{ Overwrite mode by default }
    own short   AMODE = GPR Direct
    own integer CCOL = 7     { White as Current Colour
    own short   SHADE MODE = 0 { Outline, #0 => Solid or patterns
    own short   Redraw Flag = 0
    own short   Refresh Flag = 0

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

    own short array mouse keyset (1 : 16) = 0(8), -1(*)
    own short array keyset (1 : 16) = C
       0, {2_0000000000000000           1 -    240 -255}
       0, {2_0000000000000000           2 -    224 -239}
       0, {2_0000000000000000           3 -    208 -223}
       0, {2_0000000000000000           4 -    192 -207}
       0, {2_0000000000000000           5 -    176 -191}
       0, {2_0000000000000000           6 -    160 -175}
           2_0000000001100000,{         7 -    144 -159} {return & bs}
           2_0101010100000000,{         8 -    128 -143} {arrow keys}
      -1, {2_1111111111111111           9 -    112 -127}
      -1, {2_1111111111111111          10 -     96 -111}
      -1, {2_1111111111111111          11 -     80 - 95}
      -1, {2_1111111111111111          12 -     64 - 79}
      -1, {2_1111111111111111          13 -     48 - 63}
      -1, {2_1111111111111111          14 -     32 - 47}
           2_0011111111111111,{        15 -     16 - 31} {not ^P & ^Q}
      -1  {2_1111111111111111  element 16 - char 0 - 15}

    const integer black = 0, white = 1
    own short     bitmap width  = 256,{ the x size of the bitmap}
                    bitmap height = 256,{ the y size of the bitmap}
                    zero          = 0, one = 1, dummy = 0,
                    max plane num = 3,
                    this window = 1
    own integer   true = -1, false = 0

    own short len, pad type, radius, line mode, line length

    record format font fm (short f id, byte max x, maxy)

    own record(font fm) text font1 = 0, text font2 = 0, text font3 = 0

    own record(gpr offset t) end = 0
    own short endx = 0, endy = 0

    own short stream = 1, window stream = 0,
                event type,
                repeat x = 15

    own integer display desc, bitmap desc, cursor desc, attribute desc,
                  status, obscured

    include "polyfill.apo"

    external string(255) function spec sysmess alias "IMP_SYSTEM_MESSAGE" (integer status)

    external routine APOLLO MODE alias "EDWIN_APOLLO_MODE" (integer X)
       AMODE = X if gpr direct=X or gpr borrow=X or gpr frame=X
    end

       own string(127) buffer = ""
       routine print text
          short len
          byte name ptr

          ptr == charno(buffer,1); len=length(buffer)
          obscured = gpr acquire display(status)
          gpr text(ptr,len,status)
          gpr release display(status)
          buffer = ""
       end

       own short nlines = 0
       record format Data Fm (short x, y, record (Data Fm) name Next)
       own record (Data fm) name Point List == 0
       own record (Data fm) name Next point == 0

    routine draw lines
       short array xline (1:nlines)
       short array yline (1:nlines)
       record (Data fm) name PP
       integer i
       integer dummy

       return if nlines = 0 and Point List == Nil
       pp == point list
       for I = 1, 1, Nlines cycle
          xline(i) = pp_x
          yline(i) = pp_y
          pp == pp_next
       repeat
       obscured = gpr acquire display(status)
       if Shade Mode = 0 or nlines<=2 start
           gpr polyline(xline(1),yline(1),nlines,status)
           if status # ok start
              gpr release display(dummy)
              printstring("Draw line fails. Status = ".itos(status,0).snl)
              stop
           finish
       else if Shade Mode = 1
           gpr start pgon (xline(1), yline(1), status)
           nlines = nlines - 1
           gpr pgon polyline (xline(2), yline(2), nlines, status)
           gpr close fill pgon (status)
       else
           polyfill (ccol, nlines, xline, yline)
       finish
       gpr release display(status)
       nlines = 0
    end

    routine add line(integer x,y)
       if Nlines = 0 start
           point list_x = sx;   point list_y = sy
           Next point == point list
           Nlines = 1
       finish
       Nlines = Nlines + 1
       if Next point_next == Nil start
           Next point_next == New (Next point)
           Next point      == Next point_next
           Next point_next == Nil
       else
           Next point == next point_next
       finish
       next point_x = x;   next point_y = y
    end

    routine update dd
       draw lines if nlines > 0
       print text if buffer # ""
    end

    own integer array colour map (0:256) = 0, 16_FF0000, 16_FF00,
       16_FFFF00, 16_FF, 16_FF00FF, 16_FFFF, 16_FFFFFF, 0 (*)
    own record (gpr offset t) new bitmap size, old bitmap size

    external routine spec Apollo alias "EDWIN___C" (integer Com, X, Y)

    routine Deal With Possible Resize
       unless Dev Data_Max Colour = 0 start
          radius = 7 { false = 0 already }
          gpr set colour map (false, radius, colour map (0), status)
       finish
       gpr inq bitmap dimensions (Display Desc, new bitmap size, Radius, Status)
       unless New bitmap size_x size = Old Bitmap size_x size and -
               New bitmap size_y size = Old Bitmap size_y size start
          if Fname = "DRAFT" start
             if New bitmap size_y size > 500 start
                gpr set text font(text font1_f id, status)
                Font Width = 7
                Font Height = 14
                Font Descender = 4
             else if New Bitmap Size_y size  > 300
                gpr set text font(text font2_f id, status)
                Font Width = 5
                Font Height = 10
                Font Descender = 3
             else
                gpr set text font(text font3_f id, status)
                Font Width = 4
                Font Height = 8
                Font Descender = 2
             finish
          finish
          Apollo (3, 0, 0)
          User Refresh
       finish
    end

    external routine APOLLO alias "EDWIN___C" (integer COM, X, Y)
       own integer array MAP (0:7) = 0, 7, 4, 2, 1, 5, 3, 6
       own integer WX, WY, fill value
       own short counter, just initialised = 0
       byte name ptr
       byte char
       integer height, width, x dist, y dist, Loop count
       record (gpr offset t) ss, bitmap size, dummy
       record (gpr window t) win, source win
       record (pad window desc t) pwin
       record (gpr position t) origin, p1
       string (127) file
       switch SW, AS (0:15)

       routine abort
         integer Dummy
          gpr release display(Dummy)  { Just in case it was claimed }
          Printstring ("Output command ".ItoS(Com,0)." fails : ".sysmess(status) )
          newline
          monitor if Translate ("LL_DIAG") # "LL_DIAG"
          stop
       end

       routine set background colour(integer colour)
          fill value = colour
          gpr clear(fill value,status)
          if colour & 1 = 0 then fill value = white else fill value = black
          fill value = Map(white) if fill value = white and Dev Data_Max Colour>0
          gpr set draw value(fill value,status)
       end

       routine horizontal line(integer incr)
          integer i
          for i = 0, incr, bitmap height cycle
             len = i
             gpr move(zero,len,status)
             gpr line(bitmap width,len,status)
          repeat
       end

       routine vertical line(integer incr)
          integer I
          for i = 0, incr, bitmap width cycle
             len = i
             gpr move(len,zero,status)
             gpr line(len,bitmap height,status)
          repeat
       end

       routine right diagonal(integer incr)
          integer i
          for i = 0, incr, bitmap width cycle
             len = i
             gpr move(zero,len,status)
             gpr line(len,zero,status)
             gpr move(bitmap height,len,status)
             gpr line(len,bitmap width,status)
          repeat
       end

       routine left diagonal(integer incr)
          integer i
          short dummy
          for i = 0, incr, bitmap width cycle
             len = i
             dummy = bitmap width - len
             gpr move(len,zero,status)
             gpr line(bitmap width,dummy,status)
             gpr move(dummy,bitmap width,status)
             gpr line(zero,len,status)
          repeat
       end

       routine Get Int (string (127) Value, short name Thing, integer default)
          string (127) T Value
          on 3,4,9 start
             Oper Message ("Invalid setting for ".Value)
             stop
          finish
          TValue = Translate (Value)
          Thing = Default and return if TValue = Value
          Thing = S to I (TValue)
       end

       routine Set Raster Op (integer Raster Op)
          integer loop count
          short plane, Op

          Op = Raster Op
          for Loop Count = 0, 1, max plane num cycle
             plane = loop count
             gpr set raster op (plane, op, status)
             abort if status # ok
          repeat
       end

       on 9 start
          Oper Message ("Apollo Graphics Error: ".Sys Mess (Event_Extra))
          signal 14, 1
       finish

       print text if buffer # "" and com # 6
       draw lines if nlines # 0 and com # 5
       counter = counter + 1
       if counter & 64 # 0 start
          counter = 0
          obscured = gpr acquire display(status)
          width = gpr cond event wait (event type, char, origin, status)
          if event type = gpr keystroke start
             if Interrupted start; finish
             IMP Int Flag = 1 if char=Etx or char=Del
          else if event type = gpr entered window
             if Fname = "DRAFT" start
                 Redraw Flag = 1
             else
                 Deal With Possible Resize
             finish
          finish
          gpr release display(status)
        finish

    !   Oper Message("Device driven with ".itos(com,0).itos(x,3).itos(y,3))

       -> SW(COM)

    SW(0): ! Initialise
           if fname = "DRAFT" start
              Font Width = 7
              Font Height = 14
              Font Descender = 4
              ! extend keyset to include function keys
              keyset (2) = 2_0000011100000000; ! L1A, l2A, L3A
              keyset (4) = 2_0000000011111111; ! F1 - F8
              keyset (8) = 2_1111111111111110; ! Left Keypad
           finish
           if Amode=gpr direct start
              if Window Stream = 0 start
                 sx = 1 { Unit no. }
                 file = ""
                 ptr == charno (file,1)
                 len = length(file)
                 Get int ("EDWIN_APOLLO_LEFT", pwin_left, 0)
                 Get int ("EDWIN_APOLLO_TOP", pwin_top, 0)
                 Get int ("EDWIN_APOLLO_WIDTH", ss_X Size, 1000)
                 Get int ("EDWIN_APOLLO_HEIGHT", ss_Y Size, 800)
                 pwin_width = ss_xsize + 8
                 pwin_height = ss_ysize
                 pad type = pad transcript
                 pad create window (ptr, len, pad type, sx, pwin, window stream, status)
                 abort if status # ok
                 pad set auto close (window stream, this window, true, status)
                 abort if status # ok
                 file = Translate(Fname."_ICON")
                 if file # Fname."_ICON" start
                    sy = length(file)
                    pad set icon font (window stream, this window, charno(file,1),
                                       sy, status)
                    abort if status # ok
                 finish
              else
                 pad select window (window stream, this window, status)
                 abort if status # ok
                 if Fname = "DRAFT" start
                    Redraw Flag = 1
                    Refresh Flag = 1
                 finish
              finish
              stream = window stream
           else
              stream = 1
           finish
           ss_x size = Max screen size
           ss_y size = Max screen size
           gpr init (amode, stream, ss, max plane num, display desc, status)
           abort if status # ok
           gpr set auto refresh (true, status)
           gpr inq bitmap dimensions (Display Desc, bitmap size, Radius, Status)
           old bitmap size = bitmap size
           Screen Width = Bitmap size_X size
           Screen Height = Bitmap size_Y size - 1
           if Radius = 0 start
              Max Plane Num = 0
              DEV DATA_MAX COLOUR =  0
           else
              Max Plane Num = 3
              DEV DATA_MAX COLOUR =  7
           finish
           gpr allocate attribute block(attribute desc,status)
           abort if status # ok
           bitmap size_x size = bitmap width
           bitmap size_y size = bitmap height
           gpr allocate bitmap(bitmap size, Max Plane Num, attribute desc,
                                                        bitmap desc, status)
           abort if status # ok
           gpr allocate attribute block(attribute desc,status)
           abort if status # ok
           bitmap size_x size = 16
           bitmap size_y size = 16
           gpr allocate bitmap(bitmap size, Max Plane Num, attribute desc,
                                                        cursor desc, status)
           abort if status # ok
           gpr set bitmap(display desc, status)
           abort if status # ok
           gpr set obscured opt (gpr pop if obs, status)
           mouse keyset(fill value) = 0 for fill value = 9, 1, 16
           mouse keyset(10) = 2_1110   { to enable "a", "b", "c" for mouse }
           file = Translate ("EDWIN_APOLLO_FONT")
           if file = "EDWIN_APOLLO_FONT" start
              if Fname = "DRAFT" start
                 file = "/sys/dm/fonts/helvetica12"       { The standard text font }
              else
                 file = "/sys/dm/fonts/std.19l"           { The standard text font }
                 ! This one seems to be the only one which works for Artview!
              finish
           finish
           ptr == charno (file,1)
           len  = length(file)
           gpr load font file(ptr,len,text font1_f id, status)
           abort if status # ok
           file = "/sys/dm/fonts/helvetica9"
           len  = length(file)
           gpr load font file(ptr,len,text font2_f id, status)
           abort if status # ok
           file = "/sys/dm/fonts/helvetica7"
           len  = length(file)
           gpr load font file(ptr,len,text font3_f id, status)
           abort if status # ok
           gpr set text font(text font1_f id, status)
           abort if status # ok
           file = "w"; ptr == charno(file,1); len = 1
           gpr inq text extent(ptr,len,end,status)
           text font1_maxx = end_x size if end_x size > text font1_max x
           text font1_maxy = end_y size if end_y size > text font1_max y
           gpr set bitmap(cursor desc, status)
           obscured = gpr acquire display(status)
           set background colour(black)
           for Loop Count = 7, 1, 9 cycle
               endx = Loop Count
               gpr move(endx,zero,status)
               gpr line(endx,repeat x,status)
               gpr move(zero, endx,status)
               gpr line(repeat x, endx,status)
           repeat
           gpr set cursor pattern(cursor desc, status)
           abort if status # ok
           origin_x coord = 8; origin_y coord = 8
           gpr set cursor origin(origin, status)
           abort if status # ok
           gpr set bitmap(display desc, status)
           abort if status # ok
           set background colour(black)
           unless Dev Data_Max Colour = 0 start
              radius = 7
              gpr set colour map (false, radius, colour map (0), status)
           finish
           gpr enable input (gpr entered window, zero, status)
           abort if status # ok
           gpr enable input (gpr keystroke, keyset(1), status)
           abort if status # ok
           gpr release display(status)
           Point List == New (point list) if Point List == Nil
           point List_next == Nil
           DEV DATA_NAME = "an Apollo Workstation"
           DEV DATA_DVX = Screen width - 1
           DEV DATA_DVY = Screen Height - 1
           DEV DATA_MVX = Screen width - 1
           DEV DATA_MVY = Screen Height - 1
           Just Initialised = True
           return

    SW(1): ! Terminate
           gpr terminate (false, status)
           abort if status # ok
           char = Charno (Fname, 1)
           pad make icon (window stream, this window, char, status)
           abort if status # ok
           return

    SW(2): ! Update
           return

    SW(3): ! Newframe
    !       %if amode = Gpr direct %and Just Initialised = False %start
    !          com = ccol
    !          y   = Shade Mode
    !          gpr terminate (false, status)
    !          abort %if status # ok
    !          Apollo (0, 0, 0); { This gives us the new bitmap size (if any) }
    !          ccol = com
    !          Shade Mode = y
    !          Just Initialised = False
    !       %finish
           if Device Data_Max Colour > 0 start
              X = 7;    set plane mask 32 (X, status)
           finish
           obscured = gpr acquire display (status)
           gpr clear (false, status)
           gpr release display (status)
           gpr inq bitmap dimensions (Display Desc, new bitmap size, Radius, Status)
           sx = 0
           Screen height = New bitmap size_Y Size - 1
           sy = screen height
           Device Data_MVX = New bitmap size_X size
           Device Data_MVY = Screen Height - 1
           Old Bitmap Size = New Bitmap Size
           Viewport (0, New bitmap size_x size, 0, New bitmap size_y size)
           gpr set bitmap(display desc,status)
           abort if status # ok
           Set Raster Op (Raster Op)
           Apollo (7, 0, CCol)
           gpr set linestyle (line mode, Line Length, status)
           Apollo (7, 10, Shade Mode)
           return

    SW(4): ! Move
           sx = x
           sy = screen height - y
           gpr move (sx, sy, status)
           abort if status # ok
           return

    SW(5): ! Line
           sx = x
           sy = screen height - y
           add line(sx,sy)
           return

    SW(6): ! Char
           length(buffer) = length(buffer) + 1
           charno(buffer,length(buffer)) = x
           print text if length(buffer) = 127
           return

    SW(7): ! Attribute
           return unless 0 <= X <= 15
           -> AS (X)
    AS(0): ! Set Colour
           CCol = Y
           if Dev Data_Max Colour # 0 start
              gpr set draw value (map(y), status)
              gpr set fill value (map(y), status)
              gpr set text value (map(y), status)
              if rasterop = 7 start { OR mode }
                 Y = map(y)
              else
                 Y = 7
              finish
              set plane mask 32 (Y, status)
              gpr set text background value (false, status)
           else
              if y=0 then fill value=black else fill value = white
              gpr set draw value (fill value, status)
              gpr set fill value (fill value, status)
              gpr set text value (fill value, status)
              if y=1 then fill value=black else fill value = white
              gpr inq fill value (fill value, status)
           finish
           return
    AS(1): ! Line Style
           if y=0 start
              line mode = gpr solid
           else
              line mode = gpr dotted
           finish
           Line Length = 5 * y { actually the line style required! }
           gpr set linestyle (line mode, Line Length, status)
           abort if status # ok
           return
    AS(9): ! Colour Mode
           if y=0 start
              raster op = 3   { OVERWRITE mode }
           else if y=1
              raster op = 1   { AND mode }
           else if y=2
              raster op = 7   { OR mode }
           else if y=3
              Raster op = 6   { XOR mode }
           else if y=4
              Raster op = 10  { Invert mode }
           finish
           gpr set bitmap(display desc,status)
           abort if status # ok
           Set Raster Op (Raster Op)
           Y = ccol;   X = 0
           -> AS (0)
    AS(10): ! Shade Mode
           Shade Mode = Y
           obscured = gpr acquire display(status)
           gpr set bitmap(bitmap desc, status)
           set background colour(black)
           X = 7
           set plane mask 32 (X, status)
           set raster op (3) { Overwrite mode }
           if y=0 or y=1 start           { Solid }
              ! Don't do anything, leave alone
           else if y=2
              Horizontal line (4)
           else if y=3
              Vertical Line (4)
           else if y=4                    { Left Diagonal }
              Left diagonal(4)
           else if y=5                    { Right Diagonal }
              right diagonal(4)
           else if y=6
              Left Diagonal (4)
              Right Diagonal (4)
           else if y=7
              Horizontal line (4)
              Vertical Line (4)
           else if y=8
              left diagonal(4)
              fill value = black
              gpr set draw value(fill value,status)
              ! Horizontal line (2), but offset by 1 to give better stipple overlap
              for Loop Count = 1, 2, bitmap height-1 cycle
                 len = Loop Count
                 gpr move(zero,len,status)
                 gpr line(bitmap width,len,status)
              repeat
           else if y=9
              for x = 0, 8, bitmap width - 8 cycle
                 for y = 0, 8, bitmap height - 8 cycle
                    for com = 0, 1, 3 cycle
                       endx = x + com
                       endy = y
                       gpr move(endx, endy,status)
                       endy = y + 4
                       gpr line(endx, endy, status)
                    repeat
                    for com = 0, 1, 3 cycle
                       endx = x + com + 4
                       endy = y + 4
                       gpr move(endx, endy,status)
                       endy = y + 8
                       gpr line(endx, endy, status)
                    repeat
                 repeat
              repeat
           else if y=10  { Bricks }
              horizontal line (4)
              for Loop Count = 0, 16, bitmap width - 16 cycle
                 len = Loop Count
                 for x = 0, 8, bitmap height - 8 cycle
                    endx = x
                    endy = x + 4
                    gpr move(len,endx,status)
                    gpr line(len,endy,status)
                    radius = len + 8
                    endx = endx + 4
                    endy = endy + 4
                    gpr move(radius,endx,status)
                    gpr line(radius,endy,status)
                 repeat
              repeat
           else
              ! Treat the style as if it was Solid
           finish
           gpr release display(status)
           gpr set bitmap (display desc, status)
    AS(*): return { Ignore any other attributes }

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

    SW(9): ! Upper window bounds
           XR = X;   YT = Y
    !       ! Now to set the clip
    !       win_window base_x coord = xl
    !       win_window base_y coord = screen height - yt
    !       win_window size_x size = xr-xl+1
    !       win_window size_y size = yt-yb+1
    !       gpr set clip window (win, status)
    !       abort %if status # ok
    !       gpr set clipping active (true, status)
    !       abort %if status # ok
           return

    SW(10):
            if Shade Mode = 0 start
                ! Cheat to match line style stuff on the Whitechapel
                begin
                   own short array pattern (1:4) = 16_FFFF8000, 0(*)
                   own short repeat = 1,length = 1

                   if x = 2 start
                      ! try to draw the first dot (last dot would be difficult)
                      repeat = 1 ; length = 64
                   else if x = 0
                      repeat = 0 ; length = 1 ;! set repeat to 0 to ignore pattern
                   finish
                   gpr set line pattern(repeat,pattern(1),length,status)
                   abort if status # ok
                end
            finish
            return

    SW(11): ! Overwrite mode
            Y = X;   X = 9
            -> SW(7)

    SW(12): ! Remember lower box bounds
            WX = X;   WY = Y
            return

    SW(13): ! Upper box bounds & do the box
            swap (wx, x) if wx > x
            swap (wy, y) if wy > y
            return if WX > XR or X < XL or WY > YT or Y < YB
            WX = XL if WX < XL
            WY = YB if WY < YB
            X = XR if X > XR
            Y = YT if Y > YT
            ! Box now clipped into the screen.
            obscured = gpr acquire display(status)
            win_window base_x coord = wx
            win_window base_y coord = screen height - y
            win_window size_x size  = x-wx
            win_window size_y size  = y-wy
            if Shade Mode = 0 start
                endx = win_window base_x coord; endy = win_window base_y coord
                gpr move(endx, endy, status)
                endx = endx + win_window size_x size   { Now to frame it }
                gpr line(endx, endy, status)
                endy = endy + win_window size_y size
                gpr line(endx, endy, status)
                endx = endx - win_window size_x size
                gpr line(endx, endy, status)
                endy = endy - win_window size_y size
                gpr line(endx, endy, status)
            else
                if Shade Mode > 1 start
                    height = y - wy;   width = x - wx      { Dimension of rectangle }
                    y dist = win_window base_y coord & repeat x
                    origin_y coord = win_window base_y coord
                    while height > 0 cycle
                       source win_window base_y coord = y dist
                       if height > bitmap height - y dist start
                          source win_window size_y size = bitmap height - y dist
                       else
                          source win_window size_y size = height
                       finish
                       origin_x coord = win_window base_x coord
                       x dist = win_window base_x coord & repeat x
                       while width > 0 cycle
                          source win_window base_x coord = x dist
                          if width > bitmap width - x dist start
                             source win_window size_x size = bitmap width - x dist
                          else
                             source win_window size_x size = width
                          finish
                          gpr pixel blt(bitmap desc, source win, origin, status)
                          width = width - source win_window size_x size
                          origin_x coord = origin_x coord + source win_window size_x size
                          x dist = 0             { for every other time round the loop }
                       repeat
                       width = x - wx                        { Reset the width }
                       height = height - source win_window size_y size
                       origin_y coord = origin_y coord + source win_window size_y size
                       y dist = 0        { for every other time round the loop }
                    repeat
                    endx = win_window base_x coord; endy = win_window base_y coord
                    gpr move(endx, endy, status)
                    endx = endx + win_window size_x size   { Now to frame it }
                    gpr line(endx, endy, status)
                    endy = endy + win_window size_y size
                    gpr line(endx, endy, status)
                    endx = endx - win_window size_x size
                    gpr line(endx, endy, status)
                    endy = endy - win_window size_y size
                    gpr line(endx, endy, status)
                else
                    gpr inq fill value(fill value,status)
                    if raster op = 10 {invert} start
                       origin_x coord = 0 ; origin_y coord = 0
                       p1 = win_window base
                       zero = 0
                       gpr set bitmap(display desc,status)
                       abort if status # ok
                       begin
                          short array raster ops(0 : 7)
                          integer loop count
                          abort if status # ok
                          gpr inq raster ops(raster ops(0),status)
                          abort if status # ok
                       end
                       gpr pixel blt(display desc,win,p1,status)
                       abort if status # ok
                    else
                       gpr rectangle (win, status)
                    finish
                finish
            finish
            gpr release display(status)
            return

    SW(14): ! Circle
            p1_x coord = sx;   p1_y coord = sy;   Radius = X
            obscured = gpr acquire display(status)
            if Shade mode = 0 start
                Gpr Circle (p1, Radius, status)
            else
                Gpr Circle Filled (p1, Radius, status)
            finish
            gpr release display(status)
            return

    SW(15): ! Area fill
    end

    !%external %routine draw dots %alias  "EDWIN_DRAW_DOTS" ( -
    !                 %integer lx,ly,hx,hy,gap)
    !   %record(gpr window t) clip win,rect win,dot win
    !   %integer active,i
    !   %integer lx1,ly1,hx1,hy1
    !   %short x,y,x1,y1
    !   %own %short plane = 0
    !   %short %array rasters (0:7)
    !   %record(gpr position t) p1
    !
    !   %from edwin %include specs
    !
    !   %routine abort
    !      %integer dummy
    !      gpr release display(Dummy)  { Just in case it was claimed }
    !      Printstring ("EDWIN_DRAW_DOTS fails : ".sysmess(status) )
    !      newline
    !      %stop
    !   %end
    !
    !   !
    !   ! first save all the interesting attributes
    !   !
    !   update dd      ;! draw anything outstanding
    !   gpr set bitmap(display desc,status)
    !   gpr inq constraints(clip win,active,plane,status)
    !   gpr inq raster ops(rasters(0),status)
    !   x = 0 ; y = 3
    !   %for i = 0, 1, max plane num %cycle
    !      x = i
    !      gpr set raster op(x,y,status)
    !   %repeat
    !   !
    !   ! get the bounding box for clipping
    !   !
    !   lx1 = lx ; ly1 = ly ; hx1 = hx ; hy1 = hy
    !   map to device coords(lx,ly)   ; ly = screen height - ly
    !   map to device coords(hx,hy)   ; hy = screen height - hy
    !   dot win_window base_x coord = lx
    !   dot win_window base_y coord = hy
    !   dot win_window size_x size  = hx - lx + 1
    !   dot win_window size_y size  = ly - hy + 1
    !   rect win_window base_x coord = lx
    !   rect win_window base_y coord = ly + 1 - gap
    !   rect win_window size_x size = hx - lx + 1
    !   p1_x coord = lx
    !   !
    !   ! draw vertical lines
    !   !
    !   lx = hx1 ; ly = hy1
    !   map to device coords(lx,ly)
    !   y1 = screen height - ly
    !   lx = lx1 ; ly = ly1
    !   map to device coords(lx,ly)
    !   y = screen height - ly
    !   lx = lx1 ; ly = ly1
    !   %while lx <= hx1 %cycle
    !      hx = lx ; hy = ly
    !      map to device coords(hx,hy)
    !      x = hx
    !      gpr move(x,y,status)
    !      gpr line(x,y1,status)
    !      lx = lx + gap
    !   %repeat
    !   x = 0 ; x1 = 0
    !   %for i = 0, 1, Max Plane Num %cycle
    !      x = i
    !      gpr set raster op(x,x1,status)
    !   %repeat
    !   !
    !   ! put black boxes on top
    !   !
    !   lx = lx1 ; ly = ly1
    !   %while ly < hy1 %cycle
    !      hy = ly ; lx = lx1
    !      map to device coords(lx,hy) ; lx = lx1
    !      hx = ly + gap
    !      map to device coords(lx,hx)
    !      rect win_window size_y size = hx - hy - 1
    !      p1_y coord = screen height - hx + 1
    !!      gpr bit blt(display desc,rect win,x { = 0},p1,x { = 0},status)
    !      gpr pixel blt(display desc,rect win,p1,status)
    !      abort %if status # ok
    !      ly = ly + gap
    !   %repeat
    !
    !   !
    !   ! put the old values in again
    !   !
    !   %for i = 0,1,max plane num %cycle
    !      x = i
    !      gpr set raster op(x,rasters(i),status)
    !   %repeat
    !   gpr set clip window(clip win,status)
    !   abort %if status # ok
    !%end

    const byte array Button Map ('a':'c') = 4, 1, 2

    own record (gpr position t) cursor = 0
    own short From TTGET = 0

    external routine BC alias "EDWIN___C_REQ" ( integername Char, X, Y )
       byte c = 0
       integer i
       routine abort
          integer Dummy
          gpr release display(Dummy)  { Just in case it was claimed }
          Printstring ("Request Device fails : ".sysmess(status) )
          newline
          stop
       end
       !
       !  move cursor into window, let cursor be seen,
       !  wait for a keystroke, switch cursor off again
       !  and try to return cursor from whence it came !
       !

    start again:
       if Redraw Flag = 1 start
          if Refresh Flag = 1 start
             User Refresh
          else
             Deal With Possible Resize
          finish
          Refresh Flag = 0
          Redraw Flag = 0
       finish

       update dd   ;! flush outputs
       gpr move(cursor_x coord,cursor_y coord,status)
       abort if status # ok
       gpr set cursor position(cursor,status)
       abort if status # ok
       gpr enable input (gpr locator {stop}, mouse keyset(1), status)
       abort if status # ok
       gpr enable input (gpr keystroke, keyset(1), status)
       abort if status # ok
       gpr enable input (gpr buttons, mouse keyset(1), status)
       abort if status # ok
       gpr set cursor active(true,status)
    try again :
       Char = 0
       cycle
          obscured = gpr event wait (event type, c, cursor,status)
          if event type = gpr entered window start
             gpr set cursor active(false,status)
             Deal With Possible Resize
             -> Give Result if From TTGET = True
             -> Start again
          finish
          gpr set cursor position(cursor,status)
          abort if status # ok
       repeat until event type = gpr keystroke or event type = gpr buttons
       gpr disable input(gpr locator, status)
       abort if status # ok
       if event type=Gpr buttons start
          ! at this time we are not interested in the up stroke of the mouse
          char = 0 and -> try again if From TTGET = True or not ('a'<=c<='c')
          char = Button map (c)
       else
    !      select output(0)
    !      print string("Keystroke event gives ".itos(c,0)." '".tostring(c)."'".snl)
          char = c
          if char = 150 then char = cr else if char = 149 then char = bs
       finish
    Give result:
       gpr set cursor active(false,status)
       abort if status # ok
       x = cursor_x coord
       y = screen height - cursor_y coord
    end

    external routine BSAM alias "EDWIN___C_SAM" ( integername Char, X, Y )
       byte c
       integer i
       short integer array raster ops (0:7)
       record(gpr position t) cursor origin
       integer cursor active
       record(gpr position t) starting pos = cursor

       routine abort
          integer Dummy
          gpr release display(Dummy)  { Just in case it was claimed }
          Printstring ("Sample Device fails : ".sysmess(status) )
          newline
          stop
       end
       !
       !  move cursor into window, let cursor be seen,
       !  wait for an event, switch cursor off again
       !  and try to return cursor from whence it came !
       !
       if Redraw Flag = 1 start
          if Refresh Flag = 1 start
             User Refresh
          else
             Deal With Possible Resize
          finish
          Refresh Flag = 0
          Redraw Flag = 0
       finish

       update dd   ;! flush outputs
       gpr move(cursor_x coord,cursor_y coord,status)
       abort if status # ok
       gpr set cursor position(cursor,status)
       abort if status # ok
       gpr set cursor active(true,status)
       gpr enable input (gpr locator {stop}, mouse keyset(1), status)
       abort if status # ok
       gpr enable input (gpr keystroke, keyset(1), status)
       abort if status # ok
       gpr enable input (gpr buttons, mouse keyset(1), status)
       abort if status # ok
       !
       ! wait for a first event and then get through all the rest without waiting
       ! using get cond event wait
       !
       char = 0
    do again :
       obscured = gpr event wait (event type, c, cursor,status)
       gpr set cursor position(cursor,status)
       if event type = gpr entered window start
          gpr set cursor active(false,status)
          Deal With Possible Resize
          -> Give Result
       finish
       if event type = gpr locator start
          cycle
             obscured = gpr cond event wait (event type, c, cursor,status)
             gpr set cursor position(cursor,status)
             if event type = gpr entered window start
                gpr set cursor active(false,status)
                Deal With Possible Resize
                -> Give Result
             finish
          repeat until event type # gpr locator
       finish
    !   select output(0)
       if event type=Gpr buttons start
          if 'a' <= c <= 'c' then  -
                char = Button map (c) else char = 0
    !      print string("event type is buttons          ".itos(cursor_x coord,0).-
    !           itos(cursor_y coord,4))
       else if event type = gpr keystroke
          char = c
          if char = 150 then char = cr else if char = 149 then char = bs
    !      print string("event type is keystroke        ".itos(cursor_x coord,0).-
    !           itos(cursor_y coord,4))
    !   %else %if event type = gpr locator
    !      printstring("event type is locator           ".itos(cursor_x coord,0).-
    !           itos(cursor_y coord,4))
       else
          gpr inq cursor(i,raster ops(0),cursor active,cursor,cursor origin,status)
          abort if status # ok
    !      printstring("Didn't recognise the event type ".itos(cursor_x coord,0).-
    !           itos(cursor_y coord,4)." Active = ".itos(cursor active,0))
          if starting pos_x coord = cursor_x coord and -
              starting pos_y coord = cursor_y coord start
    !         newline
             -> do again    ;! if nothing is happening don't do anything
          finish
       finish
       gpr set cursor position(cursor,status)
       abort if status # ok
       gpr disable input(gpr locator, status)
       abort if status # ok
    Give result:
       gpr set cursor active(false,status)
       abort if status # ok
       x = cursor_x coord
       y = screen height - cursor_y coord
    end

    external integer function B TT GET alias "EDWIN_SCREEN_TTGET"
       integer C, X, Y
       From TTGET = True
       BC (C, X, Y)
       From TTGET = False
       result = C
    end

    external integer function B Screen Height alias "EDWIN_SCREEN_HEIGHT"
       own short width, height, len, window no
       own short array list (0:11)
       own integer array Null (0:255)
       if Translate ("TERM") -> ("apollo") start
          pad inq Font (one, width, height, null(0), zero, len, status)
          result = 24 if Status # 0
          Pad inq Window (one, list, one, window no, status)
          result = 24 if Status # 0
          result = 5 if List (3) < 5
          result = List (3)
       finish
       result = 24
    end

    end of file