// Menu.bcpl get "Streams.d" external // Outgoing procedures [ InitParam; DisplayParam; PrintParam; Display; FindActiveParam ] external // incoming procedures [ Hint; CheckInput; GetChar GetFixed; Zero; PutTemplate; CreateDisplayStream; ShowDisplayStream SetLinePos; SetBitPos; GetBitPos; GetScanLinePos; Ws; Puts; EraseBits; SetRmarg ] external // incoming statics [ @Mtable; @PointerTable ] external // Outgoing statics [ @Returns; @Active ] static [ Returns=0; Active=0 ] static [ @Current; @selected = 0 ] //local statics structure str[ length byte; char ^ 1,255 byte ] manifest [ mouseY = #425; mouseX = #424 ] structure MF: [ MinY word MaxY word MinX word MaxX word Line byte; Inverted byte Routine word ] external lMF static lMF = size MF/16 let DisplayParam(proceedure,line,xposn; numargs nargs) = valof [ let S = Mtable!-1 let save = Current Current = Mtable let EndOfTable = Mtable + lMF*6*Mtable!-2 [ if Current>>MF.Routine eq proceedure then break if Current>>MF.Routine eq 0 then break Current = Current+lMF if Current ge EndOfTable then resultis 0 ] repeat if not Current>>MF.MinY then //ie this is a new entry [ Current>>MF.Line = line Current>>MF.MinY = GetScanLinePos(S,line) Current>>MF.MaxY = GetScanLinePos(S,line+1)-1 Current>>MF.MinX = xposn; Current>>MF.MaxX = xposn Current>>MF.Routine = proceedure ] if not SetLinePos(S,Current>>MF.Line) do [ Ws("*nline posn err. line"); resultis 0 ] if not SetBitPos(S,Current>>MF.MaxX) do [ if not SetBitPos(S,37*16) do [ Ws("*nbit posn err."); resultis 0 ] PutTemplate(S," ") ] //Current>>MF.Inverted = false proceedure(1) if save then [ SetLinePos(S,save>>MF.Line); SetBitPos(S,save>>MF.MaxX) ] let MaxX = Current>>MF.MaxX Current = save resultis MaxX ] and GetScanLinePos(stream,line) = valof [ let DCB = stream>>DS.fdcb let fontheight = 2*(DCB>>DCB.height) let initY = 0 DCB = @#420 until DCB eq stream>>DS.fdcb do [ initY=initY+DCB>>DCB.height; DCB=DCB>>DCB.next ] resultis initY*2 + fontheight*line ] and PrintParam(str,p1,p2,p3,p4) be [ if Active eq true then return let S = Mtable!-1 let Inverted = Current>>MF.Inverted //SetLinePos(S,Current>>MF.Line) //SetBitPos(S,Current>>MF.MaxX) EraseBits(S,Current>>MF.MinX-GetBitPos(S),0); Current>>MF.Inverted = 0 if str>>str.char^1 ne #40 then Puts(S,#40) PutTemplate(S,str,p1,p2,p3,p4) if str>>str.char^(str>>str.length) ne #40 then Puts(S,#40) Current>>MF.MaxX = GetBitPos(S) if (Current>>MF.MaxX-Current>>MF.MinX) ls 16 then Current>>MF.MaxX = Current>>MF.MinX + 16 MarkParam(Inverted ne 0) ] and Display(char) be [ Puts(Mtable!-1,char); Current>>MF.MaxX = GetBitPos(Mtable!-1) ] and FindActiveParam() be [ let X = @mouseX; let Y = @mouseY if Current then //see if it is still valid [ if Y gr Current>>MF.MinY & Y ls Current>>MF.MaxY & X gr Current>>MF.MinX & X ls Current>>MF.MaxX then [ Active = true; Returns = Returns+1; Current>>MF.Routine(); return ] ] //if not Button(Left,Depressed) then return MarkParam(false) //un-invert the old parameter Current = 0; Active = false let ptr = Mtable let i = 0 [ i=i+1 if (not ptr>>MF.MinY) % (i eq 6*Mtable!-2) then [ if CheckInput() then GetChar(); return ] //flush out any input & return if Y gr ptr>>MF.MinY & Y ls ptr>>MF.MaxY & X gr ptr>>MF.MinX & X ls ptr>>MF.MaxX then break ptr = ptr+lMF ] repeat Current = ptr; Active = true MarkParam(true) Returns = 0 Current>>MF.Routine(false,Returns) ] and MarkParam(mode) be [ if not Current then return unless mode eq true xor Current>>MF.Inverted then return if mode eq false then Hint(0) let S = Mtable!-1 SetLinePos(S,Current>>MF.Line) SetBitPos(S,Current>>MF.MinX) EraseBits(S,Current>>MF.MaxX-Current>>MF.MinX,-1) Current>>MF.Inverted = mode ] //The following proceedure is used only once during initialization //so it can be copied to an "init" file and discarded here //and InitParam(lines,AboveStream,Font) = valof // [ // let DCB = @#420 // let fontheight = 2*(DCB>>DCB.height)//get height of sysfont // if Font then fontheight = Font!-2 // external CreatDisplayArea // let stream,Mbuff = nil,nil // if AboveStream then // [ // Mbuff = GetFixed(lMF*lines*6+2)+2;Zero(Mbuff,lMF*lines*6) // let DispBuffLength = (38*FontHeight + 6)*lines // let DispBuff = GetFixed(DispBuffLength) // stream = CreateDisplayStream(lines, DispBuff, DispBuffLength, Font, 0, DSstopright+DSstopbottom) // ShowDisplayStream(stream,DSbelow,AboveStream) // let Dstream = CreatDisplayArea(0,2,0,1) // ShowDisplayStream(Dstream,DSabove,stream) // Mbuff!-1 = stream // Mbuff!-2 = lines // ] // stream = Mbuff!-1 // for i=1 to lines do //Send enough char's to fill each line in the stream // [ for c=0 to 120 do Puts(stream,#40) // if i ne lines do Puts(stream,$*n) // ] // SetLinePos(stream,0) // Current = 0 // resultis Mbuff // ]