// PeekInit.bcpl // Copyright Xerox Corporation 1979 // Last modified March 10, 1979 1:23 AM by Boggs get "Streams.d" get "AltoDefs.d" external [ // outgoing procedures InitPeek MyShowDisplayStream; MakeBar // incoming procedures Title; Command; PeekFinishProc MyFrame; Resets; Zero; Enqueue; Unqueue InitializeContext; CallContextList; Block InitializeZone; Allocate; Free; AddToZone CreateDisplayStream; ShowDisplayStream CreateEtherEchoer; PeekParams; ResetTimeServ CreateMiscServ; CreateEchoServ; InitPupLevel1 CreateGateConServ // outgoing statics ctxQ; show; noShow; savedPeekFP; savedIdle // incoming statics sysZone; lvSysZone; dsp; sysFont; lvUserFinishProc; lvIdle ] static [ ctxQ; show; noShow; savedPeekFP; savedIdle lastShownStream; initDone ] manifest [ stackLim = 335b black = 1 white = 0 ] //---------------------------------------------------------------------------- let InitPeek() = valof //---------------------------------------------------------------------------- [ // set up a large free storage zone let freeEnd = MyFrame() -170 let freeBegin = @stackLim @stackLim = freeEnd test freeEnd-freeBegin ls 0 ifso [ sysZone = InitializeZone(freeEnd-77777b, 77777b) freeEnd = freeEnd -77777b if freeEnd-freeBegin gr 100 then AddToZone(sysZone, freeBegin, freeEnd-freeBegin) ] ifnot sysZone = InitializeZone(freeBegin, freeEnd-freeBegin) @lvSysZone = sysZone ctxQ = Allocate(sysZone,2); ctxQ!0 = 0 let initCtx = InitializeContext(Allocate(sysZone, 1500), 1500, InitCtx) Enqueue(ctxQ, initCtx) CallContextList(ctxQ!0) repeatuntil initDone Unqueue(ctxQ, initCtx) Free(sysZone, initCtx) resultis freeBegin ] //---------------------------------------------------------------------------- and InitCtx(ctx) be //a context //---------------------------------------------------------------------------- [ savedIdle = @lvIdle; @lvIdle = Block savedPeekFP = @lvUserFinishProc; @lvUserFinishProc = PeekFinishProc // top and bottom white bars lastShownStream = MakeBar(white, 24) ShowDisplayStream(lastShownStream, DSalone) ShowDisplayStream(MakeBar(white, 1), DSbelow, lastShownStream) // set up dsp MyShowDisplayStream(MakeBar(black, 1)) dsp = CreateDisplayStream(3, Allocate(sysZone, 1500), 1500, sysFont) MyShowDisplayStream(dsp) // set up title MyShowDisplayStream(MakeBar(black, 1)) MyShowDisplayStream(MakeBar(white, 4)) let lineWords = lDCB+38*2*((sysFont!-2+1) rshift 1) show = CreateDisplayStream(1, Allocate(sysZone, lineWords+10), lineWords+5, sysFont, 0, DSnone) MyShowDisplayStream(show) noShow = CreateDisplayStream(1, Allocate(sysZone, lineWords+10), lineWords+5, sysFont, 0, DSnone) MyShowDisplayStream(MakeBar(white, 4)) MyShowDisplayStream(MakeBar(black, 2)) // set up the context machinery Enqueue(ctxQ, InitializeContext(Allocate(sysZone, 200), 200, Title)) Enqueue(ctxQ, InitializeContext(Allocate(sysZone, 200), 200, Command)) // start up the Pup package InitPupLevel1(sysZone, ctxQ, 20) // start servers CreateGateConServ() CreateEtherEchoer() CreateMiscServ(sysZone, ctxQ) CreateEchoServ(sysZone, ctxQ) PeekParams() //must FOLLOW server initialization ResetTimeServ() Resets(dsp) initDone = true // returning from a context does an implicit Block() ] //---------------------------------------------------------------------------- and MyShowDisplayStream(stream) be //---------------------------------------------------------------------------- [ ShowDisplayStream(stream, DSbelow, lastShownStream) lastShownStream = stream ] //---------------------------------------------------------------------------- and MakeBar(background, nLines) = valof //---------------------------------------------------------------------------- [ structure Bar: [ fdcb word; ldcb word; @DCB ] manifest lenBar = size Bar/16 let bar = Allocate(sysZone, lenBar, false, true); Zero(bar, lenBar) bar>>Bar.fdcb = lv bar>>Bar.next bar>>Bar.ldcb = lv bar>>Bar.next bar>>Bar.background = background bar>>Bar.width = 0 bar>>Bar.height = nLines resultis bar ]