!*********************************************************************** !* !* 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