// AIMenuInit.bcpl -- a BCPL package to define menus
//      on the display screen.
//
// This file contains procedures needed only during
//    initialization
//
// Modified by L. Stewart from Keith Knox' package
// Last touched: April 27, 1978  2:46 PM

get "AIMenuDefs.d"

external      // incoming OS statics and procedures
   [
   Zero
   ]

external      MenuInitHelp

let CreateMenuDisplayStream(MenuData,buffer,length,stream) = valof
   ScanMenuDCBChain(MenuData,buffer,length,stream)

and MenuSize(MenuData) = valof ScanMenuDCBChain(MenuData)

and ScanMenuDCBChain(MenuData,buffer,length,stream,font;numargs na) = valof
   [
   // go get data from menu tables
   let menuDCB=MenuData>>DATA.menuDCB

   // start work
   let odd=(buffer&1)
   buffer=buffer+odd
   let firstdcb,lastdcb,Size=0,0,0
   let dcb=menuDCB
   while dcb do
      [
      if dcb>>DCB.width then
         [
         if firstdcb eq 0 then firstdcb=dcb
         lastdcb=dcb
         ]
      if (na gr 1) then dcb>>DCB.bitmap=buffer+Size
      Size=Size+2*(dcb>>DCB.width)*(dcb>>DCB.height)
      dcb=@dcb
      ]
   test (na gr 1) ifso if length le Size resultis false ifnot resultis Size+1

   // MenuSize has left by now
   // still doing CreateMenuDisplayStream
   if na le 4 then font=0
   let menu=MenuData>>DATA.menu
   let stringlist=MenuData>>DATA.stringlist
   for n=1 to menu!0 do ConvertToRelative(menu!n,menuDCB)
   Zero(buffer,length-odd)
   for n=1 to menu!0 do
      [
      let bits=(menu!n)>>BOX.bits
      let flag=(menu!n)>>BOX.flag
      OutlineBox(menu!n,bits,flag)
      WriteBox(menu!n,stringlist!n,font)
      ]

   // return stream
   stream!0=firstdcb
   stream!1=lastdcb
   resultis stream
   ]

and OutlineBox(box,bits,flag;numargs na) = valof
   [
   // bits      --  width of outline in bits
   // flag=0   --  outline with zeroes (white in normal mode)
   // flag=1   --  outline with ones (black in normal mode)
   // flag=-1  --  outline by flipping memory

   // set defaults
   if (na eq 0) % (box eq 0) then resultis false
   if na ls 2 then bits=1
   if bits eq 0 then [ box>>BOX.outline=0 ; resultis true ]
   if na ls 3 then flag=-1

   // define boundaries of the box
   let Xo=box>>BOX.xorigin
   let Yo=box>>BOX.yorigin
   let Xc=box>>BOX.xcorner
   let Yc=box>>BOX.ycorner
   if Xo eq Xc % Yo eq Yc then resultis false

   // get dcb
   let dcb=box>>BOX.dcb
   if dcb eq 0 then resultis false
   let width=dcb>>DCB.width

   // draw in top border
   // using erase function from BoxUtils.asm
   // erase(nbits,wordstart,bitstart,nwords,nlines,flag [0])
   let nbits=Xc-Xo+1
   let wordstart=dcb>>DCB.bitmap+Yo*width
   erase(nbits,wordstart,Xo,width,bits,flag)

   // draw in left and right sides
   let nlines=Yc-Yo+1-2*bits
   unless nlines le 0 do
      [
      // draw in left side
      erase(bits,wordstart+bits*width,Xo,width,nlines,flag)
      // draw in right side
      erase(-bits,wordstart+bits*width,Xc,width,nlines,flag)
      ]

   // draw in bottom border
   wordstart=dcb>>DCB.bitmap+(Yc-bits+1)*width
   erase(-nbits,wordstart,Xc,width,bits,flag)

   // put in how outlined
   box>>BOX.flag=flag
   box>>BOX.bits=bits
   resultis true
   ]

and ConvertToRelative(box,dcb;numargs na) be
   [
   // check if no dcb
   if (na eq 0) % (box eq 0) then return
   if (na le 1) % (dcb eq 0) then dcb=@#420
   if box>>BOX.dcb then return

   // run over chain
   // see if a dcb exists and change coords to relative to dcb
   let top,height,left,width=0,0,0,0
   let Xo=box>>BOX.xorigin
   let Yo=box>>BOX.yorigin
   let Xc=box>>BOX.xcorner
   let Yc=box>>BOX.ycorner
   if Xo eq Xc % Yo eq Yc then return
   while dcb do
      [
      height=2*(dcb>>DCB.height)
      if top gr Yo then return
      if top+height gr Yc then
         [
         left=16*(dcb>>DCB.indentation)
         width=16*(dcb>>DCB.width)
         if (left le Xo) & (left+width gr Xc) then
            [
            box>>BOX.dcb=dcb
            box>>BOX.xorigin=Xo-left
            box>>BOX.yorigin=Yo-top
            box>>BOX.xcorner=Xc-left
            box>>BOX.ycorner=Yc-top
            ]
         return
         ]
      top=top+height
      dcb=@dcb
      ]
   ]