// CHATDIS.BCPL - Bob Sproull - Display protocol processing for CHAT. // Copyright Xerox Corporation 1979 // modified: April 13, 1979 7:01 PM (E. Taft) get "Chat.d" get "ChatDis.d" get "Streams.d" get "AltoDefs.d" //outgoing procedures external [ DisTypeIn DisTypeOut DisDisplay DisEvent DisReadFont GetsWord DisReset DisClose DisWs ] //incoming procedures external [ //CHAT AwaitDisplayConnection Sti SendMarkData BigStack SmallStack CheckShiftSwat SendScreenParams EnqueueAudioOut //OS MyFrame GotoLabel OpenFile Resets FileLength ReadBlock Allocate Free Gets Puts Closes SetBlock Zero MoveBlock Endofs CallSwat //CONTEXT CallContextList InitializeContext Block //QUEUE Unqueue Enqueue //TIMER SetTimer TimerHasExpired //BSP BSPGetMark CloseBSPSocket OpenLevel1Socket SetAllocation OpenRTPSocket CreateBSPStream BSPForceOutput ReleasePBI //CHATDISOPS ShowChar ClipRegion BitBlt Backup ClipAndDrawLine FixGray CaretControl //CHATDISCURVE CurveSetup DrawCurve //DCBPRESS DCBPress ] //outgoing statics external [ DisplayVersion //For printing at init time SS //State vector for display stuff disTypeInCtx //Pointers to contexts disTypeOutCtx disDisplayCtx disEventCtx caretTime //Time at which to switch caretOn //True if caret pattern is on ] static [ DisplayVersion=15 SS disTypeInCtx disTypeOutCtx disDisplayCtx disEventCtx caretTime caretOn ] //incoming statics external [ keys Parm Running ChatZone ScreenBuffer ScreenBufferLength YMax makeBootFile ctxQ TTYSoc; TTYStr DISSoc; DISStr staticErrCode DisErrStack DisErr ConnectionOpen DisMarkCount ] //internal statics static [ staticErrCode DisErrStack DisErr ConnectionOpen //True if display connection is open DisMarkCount //Count of marks for Dis TTY connection ShovelCount //Number of bytes to shovel from display ShovelVector // process to event process! ShovelOpByte = -1 //Op byte to output first if ne -1 OldBut //State of buttons last time TTYSyncPoint=-1 //Number of sync TTY awaiting (or -1) timingMarks = 0 ] manifest [ RTC=#430 //Real time clock ] structure Bytes[ Bytes^1,1000 byte ] //The TTY connections: let DisTypeIn() be [ let s=lv Parm>>PARM.InitialString for i=1 to s>>STR.length do Puts(TTYStr, s>>STR.char^i) SendScreenParams(TTYSoc) [ if Endofs(keys) then BSPForceOutput(TTYSoc) while Endofs(keys) do Block() let c=Gets(keys) if c eq -1 then [ while timingMarks gr 0 do [ SendMarkData(TTYSoc, MarkTimingReply) timingMarks = timingMarks -1 ] loop ] Puts(TTYStr, c) //If it's the first of the "eventtypechars", type the second one let ev=SS>>DISV.EventTypeChars rshift 8 if c eq ev then [ let nc=(SS>>DISV.EventTypeChars) & #377 if nc then Puts(TTYStr, nc) ] if SS>>DISV.Blocked ne 0 & c ne ev then [ ShovelByteToNET(DBlocked) ShovelToNet(nil, 0) //Flush buffer (RFS 10/4/78) SS>>DISV.Blocked=false ] ] repeat ] and DisTypeOut() be [ let c=Gets(TTYStr) test c ge 0 then [ if DisMarkCount gr 0 then loop // If a sync point is received, record its number in TTYSyncPoint, // and wait for display process to acknowledge goahead by // setting TTYSyncPoint=-1. if c eq SS>>DISV.EscapeChar then [ SyncAwait(-1) //Be sure it's finished processing TTYSyncPoint=Gets(TTYStr) //Sync number SyncAwait(-1) loop ] ShowChar(SS>>DISV.TTYRegion, c) ] or test c eq -1 then [ let mb=BSPGetMark(TTYSoc) if mb eq MarkSync then DisMarkCount=DisMarkCount-1 if mb eq MarkTiming then [ timingMarks = timingMarks+1; Sti(-1) ] ] or if c eq -3 then finish //Bad connection ] repeat // Wait for TTYSyncPoint to equal prescribed value. Times out // after 20 seconds, and sets proper value. and SyncAwait(val) be [ let tim=@RTC while (@RTC-tim) ls 20*27 & TTYSyncPoint ne val do Block() TTYSyncPoint=val ] and DisClose() be [DC // Following close does not have a long timeout for DISSoc. The reason is that // a close requires active intervention by the Tenex job on the other end. // Because the close is being initiated from the terminal, the chances // of getting the intervention are small. while Running ne 2 do Block() Closes(TTYStr) if DISStr then [ DISStr=0 CloseBSPSocket(DISSoc, 200) ] Running=0 Block() repeat ]DC //The Alto to Net process: and DisEvent() be [EV Block() unless ConnectionOpen then AwaitDisplayConnection() //First, check buttons: UpdateEventState() // Caret processing let caretFlip=(@RTC-caretTime) gr 0 test caretOn then [ if caretFlip then CaretControl(0) ] or [ if SS>>DISV.CaretRegion ne 0 & (caretTime eq 0 % caretFlip) then CaretControl(1) ] let but=SS>>DISV.Buttons if but ne OldBut then [BU let ChngBut=but xor OldBut let cmask=#100200; let sendit=false for n=0 to 7 do [ if (ChngBut&cmask) ne 0 then [ let enableBit=(((cmask&but) ne 0)? #177400,#377)&cmask sendit=sendit%(enableBit&SS>>DISV.EnableEvents) if (enableBit&SS>>DISV.EnableTimerStop) ne 0 then [ SS>>DISV.TimerGoing=false ] if (enableBit&SS>>DISV.EnableTimerStart) ne 0 then [ SS>>DISV.TimerGoing=true; SS>>DISV.TimerComplete=@RTC+SS>>DISV.TimerInterval ] ] cmask=cmask rshift 1 ] OldBut=but if sendit then [ let dt=@RTC-SS>>DISV.LastEventTime if dt gr 255 then dt=255 SS>>DISV.ElapsedTime=dt SS>>DISV.LastEventTime=@RTC SS>>DISV.ChangedButtons=ChngBut DisSend(lv SS>>DISV.Event, 9, true) AnnounceEvent() ] ]BU if SS>>DISV.TimerGoing ne 0 & (@RTC-SS>>DISV.TimerComplete) ge 0 then [ SS>>DISV.TimerGoing=false let v=DTimeout*256 DisSend(lv v, 1, true) AnnounceEvent() ] if ShovelCount ge 0 then [ if ShovelOpByte ne -1 then Puts(DISStr, ShovelOpByte) ShovelOpByte = -1 DisSend(ShovelVector, ShovelCount, ShovelCount eq 0) ShovelCount=-1 ] ]EV repeat //DisSend(vector,bytecount,flush) // Send some bytes to the other party. and DisSend(v,bytes,flush) be [DS for i=1 to bytes do Puts(DISStr, v>>Bytes.Bytes^i) if flush then BSPForceOutput(DISSoc) ]DS //UpdateEventState() reads state from various place in the Alto // and stores it in the state vector, so that event machinery can // find it. and UpdateEventState() be [UES SS>>DISV.Buttons=(not (@#177030)) SS>>DISV.CursorX=@#426+SS>>DISV.CursorDX //Cursor X SS>>DISV.CursorY=@#427+SS>>DISV.CursorDY //Cursor Y // Get other buttons let t=@#177036 let oth=#177420%(@#177037Ö)%(@#177035)%(td) if (tྠ) ne 0 then oth=oth%#40 SS>>DISV.OtherButtons=(not oth) ]UES // Announce an event: perhaps send a EventTypeChars character, // and clear the "blocked" flag, so typein will not generate another // event and AnnounceEvent() be [An let ev=SS>>DISV.EventTypeChars if ev then Sti(ev rshift 8) SS>>DISV.Blocked=false ]An // Net to Display process and DisDisplay() be [DS let ComB=nil //ComTab!command = number of bytes of arguments let ComTab= ( table [ 0; 3; 3; 1; 3; 1; 0; 0; 0; 0; 0; 5; 20; 12; 6; 40; 0; 0; 40; 2; 1; 0; 2; 3; 30; 4 ] ) -#200 DisErrStack=MyFrame() DisErr=lDisErr Block() repeatuntil ConnectionOpen [BL // Check for exceptional condition if ConnectionOpen eq 0 then break //Out to DS block ComB=Gets(DISStr) //Get a byte //See if it is simply a character if ComB ls #200 then [ ShowChar(SS>>DISV.CurrentRegion, ComB) loop ] //Or a special operation -- deposit in memory if ComB eq DDepositM then [ let addr=GetsWord(DISStr) let count=Gets(DISStr) for i=0 to count-1 do addr!i=GetsWord(DISStr) loop ] //Check for illegal command code if ComB gr DLargest then [ CallSwat("Illegal display protocol") loop ] //Gather arguments and dispatch [ for i=1 to ComTab!ComB do (lv (SS>>DISV.argWord^1))>>Bytes.Bytes^i=Gets(DISStr) ComInterp(ComB) loop ] lDisErr: [ER if staticErrCode eq -1 then [ BSPGetMark(DISSoc) ] //Mark if staticErrCode eq -3 then [ ConnectionOpen=false; break ] //Out to DS block loop ]ER ]BL repeat ]DS repeat //Interpret a protocol command. "op" is the op-code. Arguments are // carefully recorded in the args table (as WORDS, not bytes) and ComInterp(op) be [ let r=SS>>DISV.CurrentRegion switchon op into [CI case DSync: ShovelByteToNET(DSync) //Fall through! case DFlushInput: ShovelToNet(nil, 0) //Forces output endcase case DClose: ConnectionOpen=false //Will happen! endcase case DReset: DisReset() //Re-build display endcase case DInvalidate: [ r>>REG.BBCValid=false endcase ] case DExamineR: case DExamineV: [ let addr=SS>>DISV.argByte^1 addr=addr+((op eq DExamineR)? r, SS) compileif DExaminedR ne DExamineR % DExaminedV ne DExamineV then [ foo=nil ] ShovelOpAndVecToNet(op, addr, 2) endcase ] case DExamineM: [ let addr=SS>>DISV.argWord^1 let count=SS>>DISV.argByte^3 ShovelOpAndVecToNet(DExaminedM, addr, count*2) endcase; ] case DDepositR: case DDepositV: [ let addr=SS>>DISV.argByte^3 addr=addr+((op eq DDepositR)? SS>>DISV.CurrentRegion, SS) @addr=SS>>DISV.argWord^1 endcase ] case DPress: [ BigStack() DCBPress(lv (SS>>DISV.argWord^1), @#420) SmallStack() endcase ] case DLineTo: [ let x=SS>>DISV.argWord^1 let y=SS>>DISV.argWord^2 let wid=SS>>DISV.argByte^5 if wid ge #200 then wid=wid+#177400 ClipAndDrawLine(r, r>>REG.CurX, r>>REG.CurY, x, y, wid) r>>REG.CurX=x r>>REG.CurY=y r>>REG.BBCValid=false endcase ] case DRegionR: [ r>>REG.SLX=SS>>DISV.argWord^6 r>>REG.STY=SS>>DISV.argWord^7 RegionOp(SS>>DISV.argWord^10) endcase ] case DRegionC: [ r>>REG.STY=0 RegionOp(SS>>DISV.argWord^6) endcase ] case DCursorNudge: [ let dx=SS>>DISV.argWord^1 let dy=SS>>DISV.argWord^2 let saveit=SS>>DISV.argByte^5 let odx,ody=0,0 if saveit then [ odx,ody=SS>>DISV.CursorDX,SS>>DISV.CursorDY SS>>DISV.CursorDX=dx SS>>DISV.CursorDY=dy ] @#424=@#424+odx-dx @#425=@#425+ody-dy endcase ] case DReadState: [ let v=vec 5 MoveBlock(v, lv SS>>DISV.Event, 5) v>>Bytes.Bytes^1=DState ShovelToNet(v, 9) endcase ] case DCaretOff: [ CaretControl(0) endcase ] case DReadFont: [ BigStack() let n=SS>>DISV.argWord^1 let a=(lv SS>>DISV.fonts)!n if (a𫙰) ne 0 then Free(ChatZone, a) DisReadFont(n, lv (SS>>DISV.argWord^2), 0) SmallStack() endcase ] case DStartTimer: [ SS>>DISV.TimerGoing=true SS>>DISV.TimerComplete=@RTC+SS>>DISV.argWord^1 endcase ] case DBackup: [ CaretControl(0) Backup(r, SS>>DISV.argWord^1) endcase ] case DSyncBefore: [ SyncAwait(SS>>DISV.argByte^1) //Wait for TTY to get here endcase ] case DSyncAfter: [ TTYSyncPoint=-1 Block() //Allow TTY in right away. endcase ] case DCurveSetup: [ let drawMode=SS>>DISV.argByte^1 let brushShape=SS>>DISV.argByte^2 let brushWidth=SS>>DISV.argByte^3 CurveSetup(r, drawMode, brushShape, brushWidth) endcase ] case DCurveTo: [ let x1=SS>>DISV.argWord^1 let y1=SS>>DISV.argWord^2 let dxyVec=vec 12 MoveBlock(dxyVec, lv (SS>>DISV.argWord^3), 12) let n=SS>>DISV.argWord^15 DrawCurve(r>>REG.CurX, r>>REG.CurY, x1, y1, dxyVec, dxyVec+2, dxyVec+4, dxyVec+6, dxyVec+8, dxyVec+10, n) r>>REG.CurX=x1 r>>REG.CurY=y1 endcase ] case DAudioOut: [ EnqueueAudioOut(SS>>DISV.argWord^1, SS>>DISV.argWord^2) endcase ] ]CI ] and ShovelToNet(v, count) be [SS ShovelVector=v ShovelCount=count while ShovelCount ne -1 do Block() ]SS and ShovelByteToNET(b) be [SB b=b lshift 8 ShovelToNet(lv b, 1) ]SB and ShovelOpAndVecToNet(op, v, count) be [ ShovelOpByte = op ShovelToNet(v, count) ] and GetsWord(str) = valof [GSW let b=Gets(str) lshift 8 resultis (b+Gets(str)) ]GSW //DisReset() -- called to reset the display properly. and DisReset() be [DR Zero(ScreenBuffer, ScreenBufferLength) let dcb=ScreenBuffer+ScreenBufferLength-lDCB dcb!1=disWidth dcb!2=ScreenBuffer dcb!3=(YMax+1)/2 @#420=dcb Zero(SS+zeroDISVFirst, zeroDISVLength) let p=lv SS>>DISV.regions SS>>DISV.TTYRegion=p //TTY region = 0 SS>>DISV.CurrentRegion=p+lREG //DIS region = 1 for i=0 to Parm>>PARM.nRegions-1 do SetRegionDefault(p+i*lREG, i eq 0) SS>>DISV.Event=DEvent ]DR //SetRegionDefault(r, scroll) -- sets up all defaults in a region // sets BBCValid=false and SetRegionDefault(r, scroll) be [SRD Zero(r, size REG/16) let f=(lv SS>>DISV.fonts)!0 if f eq 0 then CallSwat("No default font") //No default font! r>>REG.Font=f let h=f>>STRIK.ascent+f>>STRIK.descent r>>REG.CurY=h*2 r>>REG.CurX=10 r>>REG.CrX=10 r>>REG.LfY=h r>>REG.Right=XMax r>>REG.Bottom=YMax r>>REG.Scroll=scroll r>>REG.BBCOp=BBCPaint+BBSBitMap r>>REG.DBCA=ScreenBuffer r>>REG.DBMR=disWidth ]SRD //RegionOp(gray) -- common code for both kinds of region ops and RegionOp(gray) be [RO let r=SS>>DISV.CurrentRegion MoveBlock(lv r>>REG.DLX, lv (SS>>DISV.argWord^2), 4) let f=SS>>DISV.argWord^1 r>>REG.Function=f r>>REG.SBCA=ScreenBuffer r>>REG.SBMR=disWidth if ClipRegion(r) then [ if (f&8) ne 0 then FixGray(r, gray) //Only do this if gray region used BitBlt(r) ] r>>REG.BBCValid=false ]RO // Font reading routine. // DisReadFont(fontNumber, name, fp) returns // 0 => cannot find file // 1 => cannot allocate storage // otherwise all is well. and DisReadFont(fontNumber, nam, fp) = valof [ compileif size STRIK-size STRIKE ne 16 then [ foo=nil ] let fa = valof [ let fs=OpenFile(nam, ksTypeReadOnly, 0, 0, fp) if fs eq 0 then resultis 0 //Non-ex font let wl=FileLength(fs)/2 let a=Allocate(ChatZone, wl+1, -1) if a eq 0 then resultis 1 //No room for it Resets(fs) ReadBlock(fs, a+1, wl) Closes(fs) let bm=lv a>>STRIK.bitmap a>>STRIK.xPosTable=bm+(a>>STRIK.raster)* (a>>STRIK.ascent+a>>STRIK.descent) a>>STRIK.max=a>>STRIK.max-a>>STRIK.min //Max tested after subtract resultis a ] (lv SS>>DISV.fonts)!fontNumber=fa resultis fa ] and DisWs(str) be [ if ConnectionOpen then return //No interference for i=1 to str>>STR.length do ShowChar(SS>>DISV.TTYRegion, str>>STR.char^i) ]