// Peek.bcpl
// Copyright Xerox Corporation 1979
// Last modified August 28, 1979  11:56 AM by Boggs

get "Pup0.decl"
get "Pup1.decl"
get "AltoFileSys.d"
get "Disks.d"
get "Streams.d"
get "SysDefs.d"
get "AltoDefs.d"

external
[
// outgoing procedures
Title; Command; PeekFinishProc
Wss; Ws; GatewayFinish

// incoming procedures
InitPeek; Junta
Allocate; AddToZone; MoveBlock; Zero
Block; CallContextList; Dismiss
Puts; Resets; Gets; GetBitPos; CharWidth; SetBitPos
ReadCalendar; WRITEUDT; PutTemplate
DoubleDifference; Enqueue; Dequeue; HLookup
LockBootServ; LockNameServ
OpenFile; HelpOpenFile; DefaultArgs

// outgoing statics
quitFlag; quitCount; versionText; gatewayGoingDown

// incoming statics
show; noShow; dsp; keys; EventVector
sysZone; sysDisk; pupRT; ctxQ; CtxRunning
lvUserFinishProc; savedPeekFP; lvIdle; savedIdle
]

static
[
quitFlag = false
quitCount = 0
versionText; gatewayGoingDown
openLock
]

//----------------------------------------------------------------------------
let Peek() be Junta(levDisplay, AfterJunta)
//----------------------------------------------------------------------------

//----------------------------------------------------------------------------
and AfterJunta() be
//----------------------------------------------------------------------------
[
versionText = "Peek of 28 Aug 79"
let endCode = InitPeek()
AddToZone(sysZone, InitPeek, endCode-InitPeek)
OpenFile = PeekOpenFile
CallContextList(ctxQ!0) repeat  //forever
]

//----------------------------------------------------------------------------
and PeekFinishProc() be
//----------------------------------------------------------------------------
[
@displayListHead = 0; for i = 1 to 30000 loop
@lvIdle = savedIdle
@lvUserFinishProc = savedPeekFP
]

//----------------------------------------------------------------------------
and Wss(stream, string) be
//----------------------------------------------------------------------------
   for i = 1 to string>>String.length do
      Puts(stream, string>>String.char↑i)

//----------------------------------------------------------------------------
and Ws(string) be Wss(dsp, string)
//----------------------------------------------------------------------------

//----------------------------------------------------------------------------
and GatewayFinish(code) be
//----------------------------------------------------------------------------
[
if code eq 1000 then  //restart
   [
   // assume a standard PeekUser.cm which invokes Peek on eventBooted
   let ev = EventVector
   while ev!0 ne 0 do ev = ev + ev>>EVM.length
   if ev-EventVector+1 ls EventVector!-1 then
      [
      ev>>EVM.type = eventBooted
      ev>>EVM.length = 1
      ev!1 = 0
      ]
   ]
finish
]

//----------------------------------------------------------------------------
and Title() be  // a context
//----------------------------------------------------------------------------
[
let lastTime, now = vec 1, vec 1
   [
   ReadCalendar(now)
   if DoubleDifference(now, lastTime) ne 0 then
      [
      Resets(noShow)
      PutTemplate(noShow, "-- $S", versionText)
      FillWithDash(190, noShow)
      WRITEUDT(noShow, 0)
      FillWithDash(365, noShow)
      let rte = HLookup(pupRT, 0)
      PutTemplate(noShow, "Alto $O#$O#",
       rte>>RTE.ndb>>NDB.localNet, rte>>RTE.ndb>>NDB.localHost)
      FillWithDash(490, noShow)
      PutTemplate(noShow, "$UD pages", sysDisk>>DSK.diskKd>>KDH.freePages)
      FillWithDash(605, noShow)

      let dcb = @displayListHead
      while dcb>>DCB.next ne show>>DS.cdcb do
         [
         if dcb eq 0 then Block() repeat
         dcb = dcb>>DCB.next
         ]
      noShow>>DS.cdcb>>DCB.next = show>>DS.cdcb>>DCB.next
      dcb>>DCB.next = noShow>>DS.cdcb
      let temp = noShow; noShow = show; show = temp
      MoveBlock(lastTime, now, 2)
      ]
   Block()
   ] repeat
]

//----------------------------------------------------------------------------
and FillWithDash(end, stream) be
//----------------------------------------------------------------------------
[
if (end-GetBitPos(stream)) gr CharWidth(stream, $*S) then Puts(stream, $*S)
while end gr GetBitPos(stream)+CharWidth(stream,$*S)+CharWidth(stream,$-) do
   Puts(stream, $-)
SetBitPos(stream, end)
]

//----------------------------------------------------------------------------
and Command() be //a context
//----------------------------------------------------------------------------
[
Ws("*N> ")
let char = nil
   [
   char = Gets(keys)
   if char ne $*S break
   ] repeat
switchon char into
   [
   case $Q: case $q:
      [
      unless Confirm("Quit") loop
      LockBootServ()
      LockNameServ()
      quitFlag = true
      Block() repeatuntil quitCount eq 0
      finish
      ]
   default: [ Ding(dsp); endcase ]
   case $?:
      [
      Ws("? Commands are: Quit")
      loop
      ]
   ]
] repeat

//----------------------------------------------------------------------------
and Confirm(string) = valof
//----------------------------------------------------------------------------
[
if string then Ws(string)
Ws(" [Confirm] ")
switchon Gets(keys) into
   [
   case $Y: case $y: case $*N: resultis true
   case $N: case $n: case $*177: resultis false
   case $?: [ Ws(" Confirm with <cr>"); endcase ]
   default: [ Ding(dsp); endcase ]
   ] repeat
]

//----------------------------------------------------------------------------
and Ding(stream) be
//----------------------------------------------------------------------------
[
InvertWindow(stream, true)
Dismiss(25)
InvertWindow(stream, false)
]

//----------------------------------------------------------------------------
and InvertWindow(stream, background) be
//----------------------------------------------------------------------------
[
let dcb = stream>>DS.fdcb
   [
   dcb>>DCB.background = background
   if dcb eq stream>>DS.ldcb return
   dcb = dcb>>DCB.next
   ] repeat
]

//----------------------------------------------------------------------------
and PeekOpenFile(name, ksType, itemSize, versionControl, hintFp, errRtn,
 zone, nil, disk, CreateStream, SNword; numargs na) = valof
//----------------------------------------------------------------------------
[
while openLock ne 0 & openLock ne CtxRunning do Block()
openLock = CtxRunning
DefaultArgs(lv na, -1)  //default all defaultable args to zero
let stream = HelpOpenFile(name, ksType, itemSize, versionControl, hintFp,
 errRtn, zone, nil, disk, CreateStream, SNword)
openLock = 0
resultis stream
]