// MenuEdit.bcpl -- design, create and edit a BCPL menu file // bldr MenuEdit MenuEditMore MenuEditReadWrite ReadUserCmItem gp Menu MenuBoxStreams MenuBox MenuBoxUtils Window // by Keith Knox last modified March 8, 1978 by L. Stewart get "MenuDefs.d" external // incoming OS procedures [ Ws Wns Gets GetFixed GetFont InitializeZone Allocate Free Zero Endofs MoveBlock ] external // incoming gp procedure [ ReadString ] external // incoming and outgoing procedures [ ReadFile WriteFile Font getnumber getname MenuInitHelp // needed for menu.bcpl // usually supplied with a menu table file Sensitize // in menueditmore.bcpl ShowSensitize DotCorners JustifyText Instructions Boundary DoDCBPress ] external // incoming OS statics [ keys dsp ] external // outgoing statics [ dcb systemdcb buffer zone stringlist boxnames highestname fontPtr menu selected ] static // internal statics [ dcb systemdcb buffer zone menu stringlist boxnames tempbox highestname=false selected fontPtr ] manifest anykey=#377 let main() be [ // set up the necessary arrays and statics etc. Setup() // loop looking for commands let key,char=nil,nil let number=nil let autodeselect=true [ // check mouse keys and keyset key=(not @#177030) & anykey switchon key into [ case 128: case 64: case 32: case 16: number=ScanMenu(menu,false,false,true) if number then AddToSelections(number) endcase case 4: number=ScanMenu(menu,false,false,true) test number ifnot MakeMenuWindow() ifso AddToSelections(number) endcase case 2: ChangeMenuWindow() ; endcase case 1: MoveMenuWindow() ; endcase ] // check keyboard if Endofs(keys) then loop char=Gets(keys) // & #177737 cv Uppercase no longer! if char eq $q then [ @#420=systemdcb Ws("*N*N*N*N*N*NQuit [ confirm with CR ]") char=Gets(keys) if char eq $*N then [ Ws("*N*N*N*N*N*N");finish ] char=$*T @#420=dcb ] // if no boxes then keyboard commands meaningless if (menu!0 eq 0) & (char ne $r) & (char ne #37) then loop switchon char into [ case $a: autodeselect=true ; endcase case $A: autodeselect=false ; endcase case $b: Boundary() ; endcase case $c: Change() ; endcase case $d: DeleteList(selected) ; endcase case $e: Sensitize(true) ; endcase case $E: Sensitize(false) ; endcase case $f: Font() ; endcase case $g: Gap() ; endcase case $i: Insert() ; endcase case $j: JustifyText(true) ; endcase case $J: JustifyText(false) ; endcase case $l: LineUp() ; endcase case $n: Name() ; endcase case $o: Outline() ; endcase case $p: DoDCBPress() ; endcase case $*T: endcase case $r: ReadFile() ; endcase case $s: Same() ; endcase case $v: ShowSensitize() ; endcase case $w: WriteFile() ; endcase case $?: Instructions() ; endcase // ($? & #177737) case #137: case #177: endcase // <DEL> -- de-selects default: loop ] if autodeselect%(char eq #177) do [ unless (char eq $?)%(char eq $*T)%(char eq $v) do Zero(selected,MaxLength) ] Refresh() ] repeat ] and Setup() be [ // setup a big buffer dcb=GetFixed(30800) Zero(dcb,30800) dcb=dcb+(dcb & 1) dcb!1=38 ; dcb!2=dcb+4 ; dcb!3=404 buffer=dcb+4 systemdcb=@#420 // setup menu and string list menu=GetFixed(MaxLength) stringlist=GetFixed(MaxLength) boxnames=GetFixed(MaxLength) selected=GetFixed(MaxLength) Zero(menu,MaxLength) Zero(stringlist,MaxLength) Zero(boxnames,MaxLength) Zero(selected,MaxLength) // setup display Ws("*N*N*N*N*N*N") Ws("MenuEdit 1.1 November 11, 1977") Ws("*NType any char to continue or ? for help.") while Endofs(keys) do loop if Gets(keys) eq $? then Instructions() @#420=dcb fontPtr=GetFont(dsp) // setup zones for allocating boxes and strings let length=MaxLength*(lBOX+10) zone=InitializeZone(GetFixed(length),length) tempbox=CreateBox(0,0,10,10,zone) ] and MakeMenuWindow() be [ // select a window with the mouse if menu!0 ge MaxLength-1 then return let box=nil let choice=SelectWindow(tempbox) test choice ifso [ // make record of box in zone menu!0=menu!0+1 box=CreateBox(0,0,10,10,zone) menu!(menu!0)=box MoveBlock(box,tempbox,lBOX) // update stringlist and boxnames stringlist!0=stringlist!0+1 boxnames!0=boxnames!0+1 boxnames!(boxnames!0)=defaultname() ] ifnot [ tempbox>>BOX.xcorner=tempbox>>BOX.xorigin+1 tempbox>>BOX.ycorner=tempbox>>BOX.yorigin+1 ] ] and ChangeMenuWindow() be ChangeMoveMenuWindow(true) and MoveMenuWindow() be ChangeMoveMenuWindow(false) and ChangeMoveMenuWindow(testflag) be [ // move a window with the mouse let number=NearestBox(menu) let box=menu!number let bits=box>>BOX.bits // remove the outline and any text let flipped=0 for n=1 to selected!0 do if number eq selected!n then flipped=true OutlineBox(box,bits) // remove old outline OutlineBox(box,1,0) // remove old dots if stringlist!number % flipped then FlipBox(box,0) OutlineBox(box) // outline by one bit // now change or move it test testflag ifnot MoveWindow(box) ifso ChangeWindow(box) OutlineBox(box) // remove one bit outline // if zero width or height box then delete it let deltaX=box>>BOX.xcorner-box>>BOX.xorigin let deltaY=box>>BOX.ycorner-box>>BOX.yorigin if deltaX eq 0 % deltaY eq 0 then [ Delete(number);return ] // put back the outline and any text OutlineBox(box,bits) // re-outline DotCorners(box) // if no outline WriteBox(box,stringlist!number,fontPtr) for n=1 to selected!0 do if number eq selected!n do FlipBox(box) ] and Change() be [ // use first window for default if selected!0 le 0 then return let number=selected!1 // now get proper size Ws("*N*N*N*N*N*N") @#420=systemdcb let box=menu!number let defwidth=box>>BOX.xcorner-box>>BOX.xorigin+1 let defheight=box>>BOX.ycorner-box>>BOX.yorigin+1 let width=getnumber("*NWindow width",defwidth) let height=getnumber("*NWindow height",defheight) if (width le 1) % (width gr 606) then width=defwidth if (height le 1) % (height gr 808) then height=defheight // change the origin and corner for all windows for n=1 to selected!0 do [ box=menu!(selected!n) box>>BOX.xcorner=box>>BOX.xorigin+width-1 box>>BOX.ycorner=box>>BOX.yorigin+height-1 checkbox(box) ] ] and DeleteList(list) be [ // delete all listed for n=1 to list!0 do [ let number=list!n if menu!number then Free(zone,menu!number) if stringlist!number then Free(zone,stringlist!number) if boxnames!number then Free(zone,boxnames!number) menu!number=-1;stringlist!number=-1;boxnames!number=-1 ] compress(menu);compress(stringlist);compress(boxnames) ] and compress(array) be [ // anything that is -1 is removed // elements on stringlist may be zero // and shouldn't be removed let ptr=1 for n=1 to array!0 do if array!n ne -1 then [ array!ptr=array!n; ptr=ptr+1 ] for n=ptr to array!0 do array!n=0 array!0=ptr-1 ] and Delete(number) be [ if menu!number then Free(zone,menu!number) if stringlist!number then Free(zone,stringlist!number) if boxnames!number then Free(zone,boxnames!number) DeleteFromMenu(menu,number) DeleteFromMenu(stringlist,number) DeleteFromMenu(boxnames,number) ] and Gap() be [ // get proper spacing if selected!0 le 1 then return Ws("*N*N*N*N*N") @#420=systemdcb let defgap=0 let gap=getnumber("*NGap between windows in bits",defgap) if (gap ls 0) % (gap gr 606) then gap=defgap Ws("*NType V or H to space vertically or horizontally.") let char=nil [ char=Gets(keys) & #177737 if char eq $V % char eq $H then break ] repeat // now do the spacing let box=nil let refbox=nil let width,height=nil,nil for n=1 to selected!0-1 do [ refbox=menu!(selected!n) box=menu!(selected!(n+1)) width=box>>BOX.xcorner-box>>BOX.xorigin height=box>>BOX.ycorner-box>>BOX.yorigin switchon char into [ case $V: box>>BOX.yorigin=refbox>>BOX.ycorner+gap+1 box>>BOX.ycorner=box>>BOX.yorigin+height endcase case $H: box>>BOX.xorigin=refbox>>BOX.xcorner+gap+1 box>>BOX.xcorner=box>>BOX.xorigin+width endcase ] checkbox(box) ] ] and Insert() be InsertName("*NString to be inserted",stringlist) and InsertName(string,array) be [ // get name or string if selected!0 le 0 then return // now get string Ws("*N*N*N*N*N*N") @#420=systemdcb for n=1 to selected!0 do [ let defstring=array!(selected!n) let name=getname(string,defstring) if name then [ if array!(selected!n) then Free(zone,array!(selected!n)) array!(selected!n)=name ] ] ] and LineUp() be [ // line up selected windows if selected!0 le 1 then return let number=selected!1 // get direction Ws("*N*N*N*N*N") @#420=systemdcb Ws("*NType V or H to line up vertically or horizontally.") let char=nil [ char=Gets(keys) & #177737 if char eq $V % char eq $H then break ] repeat // now do the line up let box=nil let refbox=menu!number let deltaX,deltaY=nil,nil for n=2 to selected!0 do [ box=menu!(selected!n) deltaX=box>>BOX.xcorner-box>>BOX.xorigin deltaY=box>>BOX.ycorner-box>>BOX.yorigin switchon char into [ case $V: box>>BOX.xcorner=deltaX+refbox>>BOX.xorigin box>>BOX.xorigin=refbox>>BOX.xorigin endcase case $H: box>>BOX.ycorner=deltaY+refbox>>BOX.yorigin box>>BOX.yorigin=refbox>>BOX.yorigin endcase ] checkbox(box) ] ] and Name() be InsertName("*NName of box",boxnames) and Outline() be [ // outline all selected windows if selected!0 le 0 return // now get outline width Ws("*N*N*N*N*N*N") @#420=systemdcb let box=menu!(selected!1) let defbits=box>>BOX.bits let width=box>>BOX.xcorner-box>>BOX.xorigin+1 let height=box>>BOX.ycorner-box>>BOX.yorigin+1 let bits=getnumber("*NOutline width in bits",defbits) if (bits ls 0)%(2*bits gr width)%(2*bits gr height) then bits=defbits for n=1 to selected!0 do OutlineBox(menu!(selected!n),bits) ] and Refresh() be [ // redo the screen Zero(buffer,38*808) checklists() for n=1 to menu!0 do [ let box=(menu!n) let bits=box>>BOX.bits OutlineBox(box,bits) DotCorners(box) WriteBox(box,stringlist!n,fontPtr) ] for n=1 to selected!0 do FlipBox(menu!(selected!n)) @#420=dcb ] and Same() be [ // make all windows same size as first if selected!0 le 1 then return let number=selected!1 // now make them all the same size let box=nil let refbox=menu!number let deltaX=refbox>>BOX.xcorner-refbox>>BOX.xorigin let deltaY=refbox>>BOX.ycorner-refbox>>BOX.yorigin for n=2 to selected!0 do [ box=menu!(selected!n) box>>BOX.xcorner=deltaX+box>>BOX.xorigin box>>BOX.ycorner=deltaY+box>>BOX.yorigin checkbox(box) ] ] and getnumber(string,defaultValue;numargs na) = valof [ Ws(string) if na gr 1 then [ Ws(" [");Wns(dsp,defaultValue);Ws("] ") ] let v=vec 127 ReadString(v) if v!0 eq 0 then [ if na gr 1 then Wns(dsp,defaultValue);resultis defaultValue ] let number=0 for n=1 to v!0 do [ if (v!n ls $0) % (v!n gr $9) then break if number gr 3276 then resultis 32767 number=number*10+v!n-$0 ] resultis number ] and getname(string,defaultString) = valof [ Ws(string) Ws(" [");if defaultString then Ws(defaultString);Ws("] ") let v=vec 127 ReadString(v) if v!0 eq 0 then [ if defaultString then Ws(defaultString) ; resultis false ] let name=Allocate(zone,v!0/2+1) name>>STRING.length=v!0 for n=1 to v!0 do name>>STRING.char↑n=v!n resultis name ] and defaultname() = valof [ // assign a new name to the box let name=Allocate(zone,8) name>>STRING.length=3 name>>STRING.char↑1=$b name>>STRING.char↑2=$o name>>STRING.char↑3=$x highestname=highestname+1 addnumber(name,highestname) resultis name ] and addnumber(name,number) be [ let R=number rem 10 if number/10 then addnumber(name,number/10) name>>STRING.length=name>>STRING.length+1 name>>STRING.char↑(name>>STRING.length)=R+$0 ] and MenuInitHelp() = valof resultis false and checkbox(box) be [ if box>>BOX.xcorner gr 605 then [ box>>BOX.xorigin=box>>BOX.xorigin-box>>BOX.xcorner+605 box>>BOX.xcorner=605 ] if box>>BOX.ycorner gr 807 then [ box>>BOX.yorigin=box>>BOX.yorigin-box>>BOX.ycorner+807 box>>BOX.ycorner=807 ] ] and AddToSelections(number) be [ selected!0=selected!0+1 selected!(selected!0)=number for n=1 to selected!0-1 do if selected!n eq number then [ DeleteFromMenu(selected,selected!0) DeleteFromMenu(selected,n) break ] ] and checklists() be [ let veclist=vec MaxLength Zero(veclist,MaxLength) for n=1 to menu!0 do [ let box=menu!n checkbox(box) let Xo=box>>BOX.xorigin let Yo=box>>BOX.yorigin let Xc=box>>BOX.xcorner let Yc=box>>BOX.ycorner if Xc le Xo % Yc le Yo % Xo ls 0 % Yo ls 0 then [ veclist!0=veclist!0+1 veclist!(veclist!0)=n ] ] if veclist!0 then Zero(selected,MaxLength) DeleteList(veclist) ]