// GateConMenu.bcpl

// Last modified February 15, 1979  2:47 PM by Boggs

get "GateConMenu.decl"
get "AltoDefs.d"

external
[
// outgoing procedures
CreateCmdBox; ResetCmdMenu; DumbBox
Error

// incoming procedures
PointInBox; DoInterior; DoBorder; CharWidth
CreateBox; DestroyBox; CreateBoxStream
CallSwat; Wss; Resets; Dismiss

// incoming statics
cmdMenu; errorDsp
]

structure String [ length byte; char ↑1,255 byte ]

//---------------------------------------------------------------------------
let Error(string) be
//---------------------------------------------------------------------------
[
Resets(errorDsp)
DoInterior(errorDsp>>BS.box, opInvert)
Dismiss(10)
DoInterior(errorDsp>>BS.box, opInvert)
Wss(errorDsp, string)
]

//----------------------------------------------------------------------------
and CreateCmdBox(action, string, extra; numargs na) = valof
//----------------------------------------------------------------------------
[
if na ls 3 then extra = 0

// figure out the dimensions of the new box
let width = 2*cmdBoxBorder + 8
for i = 1 to string>>String.length do
   width = width + CharWidth(errorDsp, string>>String.char↑i)
let height = 2*cmdBoxBorder + cmdMenu>>Menu.font>>Strike.ascent +
 cmdMenu>>Menu.font>>Strike.descent +2

// find the upper right corner of the lowest right-hand box in the menu
let top = cmdMenu>>Menu.top + menuBoxBorder  //DCB.bitmap relative
let right = cmdMenu>>Menu.left + menuBoxBorder
let box = cmdMenu>>Menu.boxQ.head; while box ne 0 do
   [
   if box>>Box.proc eq CmdBox then
      if box>>Box.relPos.top gr top % box>>Box.relPos.right gr right then
         [ top = box>>Box.relPos.top; right = box>>Box.relPos.right ]
   box = box>>Box.link
   ]

// can we add the new one to its right?
unless BoxFits(right, width, top, height) do
   [
   // not enough room to the right.
   // try down by the height of the box and all the way to the left
   right = cmdMenu>>Menu.left + menuBoxBorder
   top = top + height
   unless BoxFits(right, width, top, height) do CallSwat("cmdMenu overflow")
   ]

// create the box and its stream; write the string into it.
box = CreateBox(cmdMenu, right-cmdMenu>>Menu.left, top-cmdMenu>>Menu.top,
 width, height, CmdBox, cmdBoxBorder, 2+extra)
box>>CmdBox.on = false
box>>CmdBox.action = action
let bs = CreateBoxStream(box, false, true)
Wss(bs, string)
resultis box
]

//----------------------------------------------------------------------------
and BoxFits(right, width, top, height) =
   (right + width) le (cmdMenu>>Menu.dcb>>DCB.width*16 - menuBoxBorder) &
   (top + height) le (cmdMenu>>Menu.dcb>>DCB.height*2 - menuBoxBorder)
//----------------------------------------------------------------------------

//----------------------------------------------------------------------------
and ResetCmdMenu() be
//----------------------------------------------------------------------------
[
let box = cmdMenu>>Menu.boxQ.head; while box ne 0 do
   [
   let nextBox = box>>Box.link
   if box>>Box.proc eq CmdBox then DestroyBox(box)
   box = nextBox
   ]
]

//----------------------------------------------------------------------------
and CmdBox(box, event, nil, nil, nil, nil) be
//----------------------------------------------------------------------------
[
switchon event into
   [
   case cursorMoved:
      [
      if box>>CmdBox.on ne 0 & not PointInBox(box) then
         [
         box>>CmdBox.on = false
         DoInterior(box, opInvert, -1)
         ]
      endcase
      ]
   case redGoingUp:
      [
      if box>>CmdBox.on ne 0 & PointInBox(box) then
         [
         (box>>CmdBox.action)(box)
         box>>CmdBox.on = false
         DoInterior(box, opInvert, -1)
         ]
      endcase
      ]
   case redGoingDown:
      [
      if box>>CmdBox.on eq 0 & PointInBox(box) then
         [
         box>>CmdBox.on = true
         DoInterior(box, opInvert, -1)
         ]
      endcase
      ]
   ]
]

//----------------------------------------------------------------------------
and DumbBox(box, event, nil, nil, nil, nil) be
//----------------------------------------------------------------------------
   if event eq create then DoBorder(box, opReplace, black)