! 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