    ! Utility routines for EDWIN on VAX/VMS

    !############################################################################
    !#                                                                          #
    !#  This is a module from the EDWIN Graphics Package, which was developed   #
    !#  in the Department of Computer Science, at Edinburgh University, from    #
    !#  1978 to the present day, release 5 of EDWIN in October 1984.            #
    !#                                                                          #
    !#  The principal author of the EDWIN Graphics Package was J Gordon Hughes, #
    !#  while working for the Edinburgh University Computer Sceince Department. #
    !#  Parts of EDWIN have been produced by many different people, too many    #
    !#  too mention, working for different departments of Edinburgh and Leeds   #
    !#  Universities.                                                           #
    !#                                                                          #
    !#  This module is regarded as being in the public domain, and the authors  #
    !#  and accept no responsibility regarding the uses to which the software   #
    !#  will be put.                                                            #
    !#                                                                          #
    !############################################################################

    from Edwin include device, consts
    from Imp   include Dcdef, Flags, Lognames, SSdef, Sysmisc, SysIO

    record format BUFF FM (byte CLASS, TYPE, short WIDTH,
                           ((integer Rest) or (byte One, Two, Three, Height)))
    record format EXIT FM (integer FORWARD, HANDLER ADDR, N ARGS, REASON ADDR)

    system integer fn spec DCLEXH (record (EXIT FM) name EXIT BLOCK)
    external routine spec Set Default alias "IMP___SET_DEFAULT" (string (255) Def)
    external string (255) fn spec CURRENT PROMPT alias "IMP_CURRENT_PROMPT"

    const integer EF=1, DEL = 127, True=1, False=0
    own short CHAN, CALLED=FALSE
    own integer OLD TT MODE, EXIT REASON = 0, EXIT HANDLER ACTIVE=FALSE, VOID
    own record (EXIT FM) EXIT BLOCK
    own record (BUFF FM) TT BUFF = 0
    own string (255) BUFF=""

    const integer wrap = 16_200 { TT$M_? }
    const integer hear magic = 16_20000 { TT$M_NOBRDCST }
    const integer sense mode = 16_27, set mode   = 16_23

    routine TEST FLAG (integer FLAG)
       return if FLAG&1#0 or FLAG=0
       PRINT STRING (Get message(FLAG))
       NEWLINE
       DEV DATA_DEV NO = -1 { Re-set to NULL device }
       signal 14, 1
    end

    routine DO EXIT HANDLER
       record (IOSB FM) STATE
       if CALLED # FALSE start
          TT BUFF_REST = OLD TT MODE
          TEST FLAG (WAITFR (EF))
          VOID = (QIOW (0, CHAN, SET MODE, STATE, NIL, 0, ADDR (TTBUFF), 8, 0, 0, 0, 0))
          TEST FLAG (DASSGN(CHAN))
          CALLED = FALSE
       finish
    end

    external routine EXIT HANDLER alias "EDWIN___EXIT_HANDLER"
       DO EXIT HANDLER
    end

    external predicate Plotter Device alias "EDWIN_PLOTTER_DEVICE" -
       (string (255) Name)
       own short Chan
       integer Flag
       record (Dib Fm) Dib
       Flag = ASSIGN (Name, Chan, 0, "")
       false unless Flag&1#0 or Flag=0
       Flag = GETCHN (Chan, Dib, Nil)
       false unless Dib_Dev Class = DC Term or Dib_Dev Class = DC Mailbox -
                                              or Dib_Dev Class = DC LP
       Void = DASSGN (Chan)
       true
    end

    external routine SET DEVICE alias "EDWIN_SET_DEVICE" (string (255) TERM)
       ! Routine to set up channel to the terminal, usually done for you
       ! but can be reset to allow use of other devices.
       external integer spec EXIT HANDLER alias "EDWIN___EXIT_HANDLER"
       record(Dib Fm) Dib
       record (IOSB FM) STATE
       integer Flag

       routine Really a File
          on 9 start
             Oper Message ("Error opening file ".Term." for graphics output")
             signal 14, 1
          finish
          Viewing = 3 { since this is not the console ! }
          Term = Translate (Term)
          if Dev Data_Dev No = HP Plotter start
             Set Default (".HP")
             Open Output (Viewing, Term)
          else if Dev Data_Dev No = Dev Bitmap and Dev Data_Type = 300
             Set Default (".LIS")
             Open Output (Viewing, Term)
          else if Dev Data_Dev No = Postscript
             Set Default (".PS")
             Open Output (Viewing, Term)
          else
             Set Default (".BIN")
             Open Binary Output (Viewing, Term)
          finish
       end

       return if VIEWING > 0
       TERM = "TT" if TERM=""

       DO EXIT HANDLER if CALLED # FALSE

       Really A File and return unless Plotter Device (Term)

       ! It is a real device if we are still present
       Flag = ASSIGN (TERM, CHAN, 0, "")
       TEST FLAG (SET EF (EF))
       ! Store the current terminal mode for later use
       VOID = (QIOW (0, CHAN, SENSE MODE, STATE, Nil, 0, ADDR(TT BUFF), 8, 0, 0, 0, 0))
       OLD TT MODE = TT BUFF_REST
       ! OLD TT MODE is now the terminal state, and is returned by the exit handler or TTMODE (0)
       TT BUFF_REST = (TT BUFF_REST & (¬WRAP)) ! HEAR MAGIC
       ! Sets deaf + no wrap
       VOID = (QIOW (0, CHAN, SET MODE, STATE, Nil, 0, ADDR(TT BUFF), 8, 0, 0, 0, 0))
       if EXIT HANDLER ACTIVE # TRUE start
           EXIT BLOCK_HANDLER ADDR = ADDR(EXIT HANDLER)
           EXIT BLOCK_N ARGS = 1
           EXIT BLOCK_REASON ADDR = ADDR(EXIT REASON)
           TEST FLAG (DCLEXH (EXIT BLOCK))
           EXIT HANDLER ACTIVE = TRUE
       finish
       CALLED = TRUE
    end

    external integer function Screen Height alias "EDWIN_SCREEN_HEIGHT"
       own short Chan
       record (IOSB FM) STATE
       string (255) Term
       integer Flag

       TERM = "TT"
       Flag = ASSIGN (TERM, CHAN, 0, "")
       unless Flag&1#0 or Flag=0 start
          result = 24
       finish

       Flag = QIOW (0, Chan, Sense Mode, State, Nil, 0, Addr(TT Buff), 8, 0, 0, 0, 0)
       Void = DASSGN (Chan)
       unless Flag&1#0 or Flag=0 start
          result = 24
       finish
       result = 16_FFFFFFF if TT BUFF_Height = 0 { big number => Infinity }
       result = 5 if TT BUFF_Height < 5
       result = TT BUFF_Height
    end

    external routine TTMODE alias "EDWIN_TTMODE" (integer I)
       if i#0 start
           SET DEVICE ("TT") if CALLED = FALSE
       else
           DO EXIT HANDLER
       finish
    end

    own record (IOSB FM) STATE

    routine DOQIO (integer ADDRESS,LEN)
       SET DEVICE ("TT") if CALLED = FALSE
       ! QIO function 30 is write virtual block to the terminal.
       ! 100 is added to give the pass all feature.
       TEST FLAG (WAITFR (EF))
       TEST FLAG (QIO (EF,CHAN,16_130,STATE,Nil,0,ADDRESS,LEN,0,0,0,0))
    end

    routine DO OUTPUT
       integer A, L
       A = ADDR(BUFF)+1
       L = LENGTH (BUFF)
       return if L=0
       DOQIO(A,L)
       BUFF = ""
    end

    external routine FLUSH OUTPUT alias "EDWIN_FLUSH"
       integer A
       return if BUFF=""
       if VIEWING>=0 start
           if VIEWING#0 start
               A = OUTPUT STREAM
               SELECT OUTPUT (VIEWING)
               PRINT STRING (BUFF)
               SELECT OUTPUT (A)
               BUFF=""
           else
               DO OUTPUT
               TEST FLAG (WAITFR (EF))
           finish
       finish
    end

    external routine TTPUT alias "EDWIN_TTPUT" (integer SYM)
       LENGTH(BUFF) = LENGTH(BUFF) + 1
       CHARNO (BUFF,LENGTH(BUFF)) = SYM
       if LENGTH(BUFF)>245 start
           if VIEWING=0 then DO OUTPUT else FLUSH OUTPUT
       finish
    end

    external integer fn TTGET alias "EDWIN_TTGET"
       record (IOSB FM) STATE
       byte integer SYM
       SET DEVICE ("TT") if CALLED = FALSE
       TEST FLAG (WAITFR (EF))
       TEST FLAG (QIOW (0, CHAN, 16_271, STATE, Nil, 0,ADDR(SYM), 1, 0, 0, 0, 0))
       TEST FLAG (SET EF (EF))
       result = SYM
    end

    external integer fn TTREAD alias "EDWIN_TTREAD"
       record (IOSB FM) STATE
       string (255) OLD PROMPT
       byte SYM, ST
       SET DEVICE ("TT") if CALLED = FALSE
       TEST FLAG (WAITFR (EF))
       TEST FLAG (QIOW (0, CHAN, 16_31, STATE, Nil, 0, ADDR(SYM), 1, 0, 0, 0, 0))
       TEST FLAG (SET EF (EF))
       ! CR -> NL and NL -> CR
       if SYM=13 start
           SYM = NL and BUFF = SNL and FLUSH OUTPUT
       else
          SYM = 13 if SYM = NL
       finish
       result = SYM
    end

    external routine OPER MESSAGE alias "EDWIN_OPER_MESSAGE" (string (255) S)
       integer OS
       OS = OUTPUT STREAM
       Select output (0)
       Print string (S)
       Newline
       Select output (OS)
    end

    external routine OPER INTERACT alias "EDWIN_OPER_INTERACT" (string (255) S)
       string (127) OLD PROMPT
       integer IS, REPLY
       on 9 start
           Prompt (OLD PROMPT)
           signal 9
       finish
       IS = INPUT STREAM
       Select input (0)
       OLD PROMPT = CURRENT PROMPT
       Prompt (S)
       Read symbol (REPLY) until REPLY&95='Y'
       Read symbol (REPLY) until REPLY=NL
       Select input (IS)
       Prompt (OLD PROMPT)
    end

    external routine TEK INPUT alias "EDWIN___TEK_INPUT" (integer name A, X, Y, integer cursor)
       integer st, b, c, d, e, f
       string (255) old prompt
       ttput (27);   ttput (cursor);   flush output
       A = ttread;   B = ttread;   C = ttread;   D = ttread;   E = ttread
       F = ttread
       X = (B&31)<<5!C&31
       Y = (D&31)<<5!E&31
    end

    external integer fn MUL DIV alias "EDWIN___MUL_DIV" (integer A, B, C)
       ! Calculates int(A*B/C) to double precision.
       integer RES, REM

       result = 0 if A=0 or B=0 or C=0
       *EMUL _ A, B, #0, 2
       *EDIV _ C, 2, RES, REM
       RES = RES + 1 if REM > C//2
       result = RES
    end

    end of file