// AIMenu.bcpl -- a BCPL package to define menus // on the display screen. // A menu is defined as a collection of "boxes". // A "box" is defined by an "origin" (upper left corner) and // a "corner" (lower right corner). If a bitmap exists // for the box then a dcb is specified and the origin // and corner are given relative to the dcb bitmap. // // Modified by L. Stewart from Keith Knox' package // Last touched: April 27, 1978 2:31 PM get "AIMenuDefs.d" external // incoming OS statics and procedures [ dsp GetFont CharWidth ] let ScanMenu(menu,loopOverMenu,returnKey,ignoreSense;numargs na) = valof [ // returns false if nothing selected // returns true if dcb exists but not on the screen // if box was selected returns key in left byte // and position in vector in right byte // default case if (na eq 0) % (menu!0 eq 0) then resultis false if na le 1 then loopOverMenu=true if na le 2 then returnKey=false if na le 3 then ignoreSense=false // define variables let key=(not @#177030) & #377 let box=nil let top,left=nil,nil let Xo,Xc,Yo,Yc=nil,nil,nil,nil // major loop over the menu [ for n=1 to menu!0 do // first word after menu is length [ box=menu!n if (box>>BOX.sensitive ne 0) % ignoreSense then [ if CursorInside(box) then [ key=(not @#177030) & #7 switchon key into [ case 1: case 2: case 4: top=FindDCB(box) if top eq -1 resultis true FlipBox(box) left=top?16*((box>>BOX.dcb)>>DCB.indentation),0 Xo=box>>BOX.xorigin+left Xc=box>>BOX.xcorner+left Yo=box>>BOX.yorigin+top Yc=box>>BOX.ycorner+top if select(Xo,Xc,Yo,Yc,key) resultis n+(returnKey ? (key lshift 8),0) FlipBox(box) ] ] ] ] ] repeatwhile loopOverMenu resultis false ] and CursorInside(box,XCursor,YCursor;numargs na) = valof [ // default cursor location to center of cursor if (na eq 0) % (box eq 0) then resultis false if na ls 3 then [ XCursor=0 ; YCursor=0 ] XCursor=@#424+XCursor YCursor=@#425+YCursor // define box coords let Xo=box>>BOX.xorigin let Xc=box>>BOX.xcorner let Yo=box>>BOX.yorigin let Yc=box>>BOX.ycorner if Xo eq Xc % Yo eq Yc then resultis false // if dcb was specified, find absolute coords from dcb chain let top=FindDCB(box) // returns # lines to the dcb if top eq true then resultis false // couldn't find the dcb let left=top ? 16*((box>>BOX.dcb)>>DCB.indentation),0 Xo=Xo+left Yo=Yo+top Xc=Xc+left Yc=Yc+top // compare cursor coords to absolute coords if (XCursor ge Xo) & (XCursor le Xc) then [ if (YCursor ge Yo) & (YCursor le Yc) then resultis true ] resultis false ] and FlipBox(box,flag;numargs na) = valof [ // check arguments if (na eq 0) % (box eq 0) then resultis false if na ls 2 then flag=true // get dcb let dcb=box>>BOX.dcb if dcb eq 0 then resultis false let width=dcb>>DCB.width // define boundaries of the box let bits=box>>BOX.bits 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 // flip the box let nbits=Xc-Xo+1-2*bits let wordstart=dcb>>DCB.bitmap+(Yo+bits)*width let nlines=Yc-Yo+1-2*bits if (nbits le 0) % (nlines le 0) then resultis false erase(nbits,wordstart,Xo+bits,width,nlines,flag) resultis true ] and FindDCB(box,dcb;numargs na) = valof [ // return number of lines to top of dcb for box // return false if dcb entry eq 0 // return true if dcb supposed to be but not there // check if no dcb if (na eq 0) % (box>>BOX.dcb eq 0) then resultis false if (na le 1) % (dcb eq 0) then dcb=@#420 // look for dcb and count lines let top=0 while dcb do [ if dcb eq box>>BOX.dcb then resultis top top=top+2*(dcb>>DCB.height) dcb=@dcb ] resultis true ] and WriteBox(box,string,font;numargs na) be [ // Jiggered up for left justified // set defaults if (na ls 1) % (box eq 0) then return if (na ls 2) % (string eq 0) then return if (na ls 3) % (font eq 0) then font=GetFont(dsp) // calculate the bit length of the string let length=0 for n=1 to string>>STRING.length do [ length=length+CharWidth(font,string>>STRING.char↑n) ] // get coordinates 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 // calculate where the string goes let charheight=font!(-2) let bits=box>>BOX.bits let width=Xc-Xo+1-2*bits let height=Yc-Yo+1-2*bits let xstart=Xo+(width-length)/2+bits if xstart ls Xo then xstart=Xo+bits if box>>BOX.ljustified ne 0 then xstart = Xo+bits+box>>BOX.joffset let ystart=Yo+(height-charheight)/2+bits if ystart ls Yo then ystart=Yo+bits // now put it out // write(StringPointer,nwrds,dba,wad,bitlimit,FontPointer) let dcb=box>>BOX.dcb let wordstart=dcb>>DCB.bitmap+ystart*(dcb>>DCB.width) write(string,dcb>>DCB.width,xstart+1,wordstart,width,font) return ]