// DKS.bcpl -- Display and Keyboard Support // Copyright Xerox Corporation 1979, 1983 // Last modified January 8, 1983 3:50 PM by Boggs get "AltoDefs.d" get "SysDefs.d" get "Disks.d" get "Streams.d" get "AltoFileSys.d" get "Time.d" get "ComStruct.bcpl" static [ ScrollResult UserLineCheckpoint UserBitCheckpoint UserLines = defaultUserLines // size of display UserLineEnds // vector 0..UserLines-1 of endpoints BoldFont = 0 RegularFont = 0 PreTimeDcb ScrollsSinceOK ShouldSetTime ShowTime TimeOutCommand = 0 TIMESTR1 TIMESTR2 USERSTR ] manifest [ DisplayHead = #420 ] let WriteSys(C) be [ WriteChars(C, 0, dsp) ] and WRITE(C, BreakBetweenPages; numargs na) = valof [ if na ls 2 then BreakBetweenPages = false unless BreakBetweenPages do ScrollsSinceOK = 0 resultis WriteChars(C, 0, USERSTR) ] and RESETPAGE(S) be [ ScrollsSinceOK = 0 ] and WriteChars(C, RTN, Stream) = valof [ ScrollResult = 0 test (C ge 0) & (C le #377) ifso test RTN eq 0 ifso [ Puts(Stream, C & #177) resultis ScrollResult ] ifnot resultis RTN(C & #177) // MASK TO 7 BITS ifnot [ let L = C>>STRING.length let T = 0 let I = 1 while (T eq 0) & (I le L) do [ let char = C>>STRING.char^I switchon char into [ case #300: [ Bold(Stream); endcase ] case #301: [ UnBold(Stream); endcase ] default: T = WriteChars(char, RTN, Stream) ] I = I+1 ] resultis T ] ] and PRETTYWRITE(C) = valof [ let BlankWidth = CharWidth(USERSTR, $*S) let ColWidth = 10*BlankWidth let CurPos = GetBitPos(USERSTR) let NewPos = ((CurPos+3*BlankWidth)/ColWidth+1)*ColWidth let CWidth = BitWidth(USERSTR, C) test CWidth+NewPos ge GetRmarg(USERSTR) ifnot SetBitPos(USERSTR, NewPos) ifso [ let Result = WRITE($*N, true) if Result ne 0 then resultis Result ] resultis WRITE(C, true) ] and CanOverlay() = valof [ static [ free ] let Check(od) be unless ReleaseOverlay(od, true) do free = false free = true LockPendingCode() GeneratePresentOverlays(Check) resultis free ] and TwiddleThumbs(TimeOutQ) be [ manifest [ // 20 minutes is 1,200,000 1 ms ticks TwentyMinHi = 18 // x/65536 TwentyMinLo = 20352 // x mod 65536 // 1 minutes is 120,000 1 ms ticks OneMin = 165140b // 60000d ] let SortTimer = vec 1 let IdleTimer = vec 1 let CursorTimer = vec 1 let SpinDownTimer = vec 1 let PassNumber = 0 SETUPCLK(SpinDownTimer, 1000) // 1 sec SETUPCLK(SortTimer, OneMin) SETUPCLK(IdleTimer, TwentyMinLo, TwentyMinHi) let LineDelta = GetLinePos(USERSTR)-UserLineCheckpoint let BitPos = GetBitPos(USERSTR) Puts(USERSTR, $*S) while Endofs(keys) do [ if TIMEHASCOME(SpinDownTimer) & (@DiskStatus & #40) ne 0 then EtherBoot(0) SETUPCLK(CursorTimer, 500) // 1/2 second RemoveCursor(UserLineCheckpoint+LineDelta, BitPos) PassNumber = PassNumber+1 Puts(USERSTR, (((PassNumber&1) eq 0)? $*S, $|)) if (@DiskStatus & #40) eq 0 then // Disk ready [ if ShouldSetTime & DIRSTATE eq PAGESCOUNTED & CanOverlay() then [ ShouldSetTime = false SetTime() SETUPCLK(CursorTimer, 500) // 1/2 second SETUPCLK(SortTimer, OneMin) SETUPCLK(IdleTimer, TwentyMinLo, TwentyMinHi) ] SETUPCLK(SpinDownTimer, 1000) // 1 sec INITDIRBLK(true) // GET DIRECTORY INTO CORE if directoryOutOfSort & TIMEHASCOME(SortTimer) & CanOverlay() then [ directoryOutOfSort = false WriteSortedDirectory() ] if TimeOutQ ne 0 & TIMEHASCOME(IdleTimer) then [ WriteSortedDirectory() if TimeOutCommand eq 0 then DIAGNOSE() STRINGTOQR(TimeOutCommand, TimeOutQ) PUTQR(TimeOutQ, $*n) break ] ] let tlc = 0 until TIMEHASCOME(CursorTimer) % (not Endofs(keys)) do [ if (tlc&7) eq 0 then MAKETIMELINE() tlc = tlc + 1 ] ] RemoveCursor(UserLineCheckpoint+LineDelta, BitPos) ] and RemoveCursor(BLine, BBitPos) be [ let CurLine = GetLinePos(USERSTR) while CurLine gr BLine do [ ResetLine(USERSTR) CurLine = CurLine-1 SetLinePos(USERSTR, CurLine) ] SetBitPos(USERSTR, BBitPos) EraseBits(USERSTR, GetRmarg(USERSTR)-BBitPos) SetBitPos(USERSTR, BBitPos) ] and FlashScreen() be [ let invert() be [ let dcb = @DisplayHead until dcb eq 0 do [ dcb>>DCB.background = dcb>>DCB.background xor 1 dcb = dcb>>DCB.next ] ] invert() let FlashTimer = vec 2 SETUPCLK(FlashTimer, 250) // 1/4 second let dummy = 250 until TIMEHASCOME(FlashTimer) do [ dummy = dummy*dummy ] invert() ] and Bold(Stream) be [ if RegularFont eq 0 then SetUpBold(Stream) SetFont(Stream, BoldFont) ] and UnBold(Stream) be [ if RegularFont eq 0 then SetUpBold(Stream) SetFont(Stream, RegularFont) ] and SetUpBold(Stream) be [ RegularFont = GetFont(Stream) BoldFont = Allocate(CZ,2)+2 BoldFont!-2 = -1 BoldFont!-1 = RegularFont ] and InitUserLine(Prompt) be [ WRITE($*N) WRITE(Prompt) UserLineCheckpoint = GetLinePos(USERSTR) UserBitCheckpoint = GetBitPos(USERSTR) ] and FitsThisLine(S, C, Extra; numargs na) = valof [ resultis (GetRmarg(S) gr (GetBitPos(S)+BitWidth(S, C)+ ((na ge 3)? Extra, 0))) ] and BitWidth(S, C) = valof [ if (C le 0) % (C ge #377) then [ let Sum = 0 for i=1 to C>>STRING.length do Sum = Sum+CharWidth(S, C>>STRING.char^i) resultis Sum ] resultis CharWidth(S, C) ] and UserScroll(ds, char; numargs na) = valof [ if na ls 2 then resultis DefaultScroll(ds) switchon char into [ case $*N: endcase case #11: // tab resultis DefaultScroll(ds, char) case $*L: case 0: // null, lf resultis char case -1: // about to burp lines up one resultis TestScrollCount(ds) case -2: // about to lose data off top of screen resultis char default: [ test char ls #40 ifso [ Puts(ds, $^); Puts(ds, char+#100) ] ifnot endcase resultis char ] ] let curBit = GetBitPos(ds) let rpos = CharWidth(ds, char) + curBit if rpos le GetRmarg(ds) then // char really fits resultis DefaultScroll(ds, char) let curLine = GetLinePos(ds) UserLineEnds!curLine = curBit unless SetLinePos(ds, curLine+1) do resultis DefaultScroll(ds, char) SetBitPos(ds, GetLmarg(ds)) if char ne $*N then Puts(ds, char) resultis char ] and TestScrollCount(ds) = valof [ if ScrollsSinceOK ge UserLines-1 then [ ScrollsSinceOK = 0 if LASTONEINKEYS(CONTROLC) ne 0 then [ ScrollResult = CONTROLC resultis false ] Wss(ds, "*NMore?") Resets(keys) while Endofs(keys) do INITDIRBLK(true) if LASTONEINKEYS(CONTROLC) ne 0 then [ ScrollResult = CONTROLC resultis false ] let c = Gets(keys) Puts(ds,$*n) switchon c into [ case $N: case $n: case #177: ScrollResult = Capitalize(c) resultis false default: ] while FitsThisLine(ds, $~) do Puts(ds, $~) ScrollsSinceOK = 0 ] for i = 0 to UserLines-1 do UserLineEnds!i = UserLineEnds!(i+1) UserLineCheckpoint = UserLineCheckpoint-1 ScrollsSinceOK = ScrollsSinceOK+1 resultis true ] and OverType(Q, PROMPT) be [ if UserLineCheckpoint ls 0 then [ RETYPE(Q, WRITE, PROMPT) return ] let CurLinePos = GetLinePos(USERSTR) let CurBitPos = GetBitPos(USERSTR) SetLinePos(USERSTR, UserLineCheckpoint) SetBitPos(USERSTR, UserBitCheckpoint) let SavedULC = UserLineCheckpoint MapQ(Q, WRITE) // This may decrement UserLineCheckpoint UserLineCheckpoint = SavedULC let NewLinePos = GetLinePos(USERSTR) let NewBitPos = GetBitPos(USERSTR) EraseBits(USERSTR, GetRmarg(USERSTR)-NewBitPos) while NewLinePos ls CurLinePos do [ SetLinePos(USERSTR, CurLinePos) ResetLine(USERSTR) CurLinePos = CurLinePos-1 ] SetBitPos(USERSTR, NewBitPos) SetLinePos(USERSTR, NewLinePos) ] and EraseChar(c) = valof [ if c ls #40 then [ if c eq $*T % c eq $*N then resultis false if c eq $*L % c eq 0 then resultis true test EraseChar(c+#100) ifso resultis EraseChar($^) ifnot resultis false ] let width = CharWidth(USERSTR, c) if GetBitPos(USERSTR)-width ge GetLmarg(USERSTR) then [ // on this line EraseBits(USERSTR, -width) resultis true ] let curLine = GetLinePos(USERSTR) if curLine eq 0 resultis false ResetLine(USERSTR) curLine = curLine-1 SetLinePos(USERSTR, curLine) SetBitPos(USERSTR, UserLineEnds!curLine) resultis EraseChar(c) ] and RETYPE(TOQ, WriteFn, PROMPT) be [ if PROMPT eq 0 then return test WriteFn eq WRITE ifso test UserLineCheckpoint ge 0 ifso [ let curLine = GetLinePos(USERSTR) until curLine eq UserLineCheckpoint do [ ResetLine(USERSTR) curLine = curLine-1 SetLinePos(USERSTR, curLine) ] SetBitPos(USERSTR, UserBitCheckpoint) EraseBits(USERSTR, GetRmarg(USERSTR)-UserBitCheckpoint) SetBitPos(USERSTR, UserBitCheckpoint) ] ifnot InitUserLine(PROMPT) ifnot [ WriteFn($*N) WriteFn(PROMPT) ] MapQ(TOQ, WriteFn) ] and MapQ(Q, Fn) be [ let MYQ = vec size QS/16 INITQ(MYQ) until ISEMPTYQ(Q) do [ let C = GETQF(Q) Fn(C) PUTQR(MYQ, C) ] APPENDQ(Q, MYQ, Q) ] and LOOKFORCTLC() = valof [ let CharNoOfLastCtlC = LASTONEINKEYS(CONTROLC) if CharNoOfLastCtlC ne 0 then [ for I=1 to CharNoOfLastCtlC-1 do Gets(keys) resultis true ] resultis false ] and LASTONEINKEYS(char) = valof [ let CurrentCharNo = 1 let CharNoOfLastGoodie = 0 let NextOut = OsBuffer>>OsBUF.Out if NextOut eq OsBuffer>>OsBUF.Last then NextOut = OsBuffer>>OsBUF.First while NextOut ne OsBuffer>>OsBUF.In do [ if @NextOut eq char then CharNoOfLastGoodie = CurrentCharNo CurrentCharNo = CurrentCharNo+1 NextOut = NextOut+1 if NextOut eq OsBuffer>>OsBUF.Last then NextOut = OsBuffer>>OsBUF.First ] resultis CharNoOfLastGoodie ] and CatchBlankKeys(kbTable) = valof [ if kbTable>>KBTRANS.Transition ge 0 then resultis true let char = nil switchon kbTable>>KBTRANS.Transition & 377b into [ case 30: // spare2 [ char = 202b; endcase ] case 31: // spare1 [ char = 201b; endcase ] case 61: // spare3 [ char = 203b; endcase ] default: resultis true ] let newIn = OsBuffer>>OsBUF.In + 1 if newIn eq OsBuffer>>OsBUF.Last then newIn = OsBuffer>>OsBUF.First if newIn ne OsBuffer>>OsBUF.Out then [ @(OsBuffer>>OsBUF.In) = char OsBuffer>>OsBUF.In = newIn ] resultis false ] and MAKETIMELINE() be [ ShowTime = ShowTime eq TIMESTR1? TIMESTR2, TIMESTR1 WriteChars(FORMATN("*n-- ",ExecRelease), 0, ShowTime) let TIME = vec lenUTV UNPACKDT(0, TIME) let MESSAGE = vec 100 test (TIME>>UTV.year ls 1983) % (TIME>>UTV.year gr 1990) ifso FORMAT(MESSAGE, " Date and Time Unknown - Pages --", sysDisk>>DSK.diskKd>>KDH.freePages) ifnot [ FORMAT(MESSAGE, " day - :: - Pages --", selecton TIME>>UTV.weekday into [ case 0: "Mon" case 1: "Tues" case 2: "Wednes" case 3: "Thurs" case 4: "Fri" case 5: "Satur" case 6: "Sun" ], selecton TIME>>UTV.month into [ case 0: "Jan" case 1: "Feb" case 2: "Mar" case 3: "Apr" case 4: "May" case 5: "Jun" case 6: "Jul" case 7: "Aug" case 8: "Sep" case 9: "Oct" case 10: "Nov" case 11: "Dec" ], TIME>>UTV.day, valof [ let HOUR = TIME>>UTV.hour if HOUR ge 12 then HOUR = HOUR-12 if HOUR eq 0 then HOUR = 12 resultis HOUR ], TIME>>UTV.minute, TIME>>UTV.second, ((TIME>>UTV.hour ls 12)? "am", "pm"), sysDisk>>DSK.diskKd>>KDH.freePages) ] let MSGWidth = BitWidth(ShowTime, MESSAGE) while FitsThisLine(ShowTime, $-, MSGWidth) do Puts(ShowTime, $-) Wss(ShowTime, MESSAGE) PreTimeDcb>>DCB.next = ShowTime>>DS.fdcb ]