!***********************************************************************
!*
!*                       Program to clear screen
!*
!*            Martin Gray    University of Edinburgh    1984
!*
!*        Modified by R.D. Eager   University of Kent   MCMLXXXV
!*
!***********************************************************************
!
!
!***********************************************************************
!*
!*          Constants
!*
!***********************************************************************
!
constantinteger  true = 1, false = 0
constantinteger  max scan = 20;         ! Max number of screen sweeps
constantinteger  default scan = 5;      ! For null or invalid parameter
constantinteger  max store = 30000
constantinteger  max bite = 75;         ! Characters in single transfer
constantlonginteger  int mask = x'0002000a0002000a'
                                        ! Interrupts a, c, q, A, C, Q
constantstring  (1) snl = "
"
!
!
!***********************************************************************
!*
!*          Own variables
!*
!***********************************************************************
!
ownstring (255) saved modes
owninteger  chars
!
!
!***********************************************************************
!*
!*          Subsystem references
!*
!***********************************************************************
!
systemstringfunctionspec  failuremessage(integer  mess)
externalstringfunctionspec  modestr
systemintegerfunctionspec  pstoi(string (63) s)
systemroutinespec  reroutecontingency(integer  ep,class,
                                      longinteger  mask,
                                      routine  ontrap,
                                      integername  flag)
systemroutinespec  setfname(string (63) s)
externalroutinespec  setmode(string (255) s)
externalroutinespec  set return code(integer  i)
systemroutinespec  signal(integer  ep,p1,p2,integername  flag)
externalstringfunctionspec  vduc(integer  x,y)
externalintegerfunctionspec  vdui(integer  n)
externalstringfunctionspec  vdus(integer  n)
!
systemroutinespec  console(integer  ep,integername  start,len)
!
!
!***********************************************************************
!*
!*          Director references
!*
!***********************************************************************
!
externalintegerfunctionspec  ddelay(integer  secs)
!
!
!***********************************************************************
!*
!*          Service routines
!*
!***********************************************************************
!
externalroutine  ontrap(integer  class,subclass)
externalroutinespec  reset security(integer  flag)
integer  flag
!
flag = 0
reset security(flag)
signal(3,class,subclass,flag)
end ;   ! of ontrap
!
!-----------------------------------------------------------------------
!
externalroutine  reset security(integer  flag)
flag = -1
console(9,flag,flag);                   ! Wait for output to finish
setmode(saved modes)
reroutecontingency(0,0,0,on trap,flag)
end ;   ! of reset security
!
!-----------------------------------------------------------------------
!
routine  set security(integername  flag)
externalroutinespec  ontrap(integer  class,subclass)
saved modes = modestr
reroutecontingency(3,65,int mask,ontrap,flag)
setmode("G,H=0")
end ;   ! of set security
!
!-----------------------------------------------------------------------
!
routine  printchs(string (255) s,byteintegerarrayname  store)
integer  i
!
for  i = 1,1,length(s) cycle 
   exit  if  chars = max store
   chars = chars + 1
   store(chars) = charno(s,i)
repeat 
end ;   ! of printchs
!
!-----------------------------------------------------------------------
!
routine  send block(byteintegerarrayname  store)
integer  adr,n,bbc
string (255) s
!
s = vdus(0);                            ! Terminal name
if  s -> ("BBC") then  bbc = true else  bbc = false
adr = addr(store(1))
!
! Do  output  in  sections  to  avoid  blowing up brain damaged terminal
! emulators such as the UKC BBC VDU ROM.
!
cycle 
   n = max bite
   n = chars if  chars < n
   console(10,adr,n)
   adr = adr + n
   chars = chars - n
   if  bbc = true then  n = ddelay(1)
repeat  until  chars <= 0
end ;   ! of send block
!
!
!***********************************************************************
!*
!*          Z C L E A R
!*
!***********************************************************************
!
externalroutine  zclear(string (255) scans)
integer  i,scan,lines,cols,strip width,x,y,flag
byteintegerarray  store(1:max store)
string (255) ups,downs,cursor ups,cursor downs,clear eolns,print str
stringname  dir
!
scans = "0" if  scans = ""
scan = pstoi(scans)
if  scan < 0 then  start 
   setfname(scans)
   flag = 202;                          ! Invalid parameter
   -> err2
finish 
!
if  scan = 0 then  start 
   scan = default scan
else 
   if  scan > max scan then  scan = max scan
finish 
!
cursor ups = vdus(6)
cursor downs = vdus(7)
cols = vdui(2)
lines = vdui(3)
strip width = cols//scan
!
chars = 0
if  lines = 0 or  cursor ups = "" or  cursor downs = "" then  start 
   unless  vdus(1) # "" then  start 
      setfname("Unsuitable terminal")
      flag = 233;                       ! General error
      -> err2
   finish 
finish 
!
set security(flag)
-> err if  flag # 0
!
clear eolns = vdus(3)
if  clear eolns = "" then  start 
   printchs(vdus(1),store);             ! Just clear the screen
   flag = 0
   -> print buffer
finish 
!
ups = clear eolns
downs = clear eolns
!
for  i = 1,1,lines - 1 cycle 
   ups = ups.cursor ups.clear eolns
   downs = downs.cursor downs.clear eolns
repeat 
!
for  i = scan-1,-1,0 cycle 
   x = i*strip width
   if  i & 1 = 0 then  start 
      y = lines - 1
      dir == ups
   else 
      y = 0
      dir == downs
   finish 
   print str = vduc(x,y)
   printchs(print str.dir,store)
repeat 
!
print buffer:
!
send block(store)
!
err:
!
reset security(flag)
!
err2:
!
if  flag # 0 then  start 
   printstring(snl."ZCLEAR fails -".failuremessage(flag))
finish 
set return code(flag)
return 
end ;   ! of zclear
endoffile