// 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
]