// MenuEditReadWrite.bcpl -- read and write out bcpl files
//  containing the menu description.

get "MenuDefs.d"


external		// incoming OS procedures
	[
	Ws
	Wss
	Wns
	Gets
	Puts
	GetFixed
	FixedLeft
	Zero
	Endofs
	OpenFile
	Closes
	Resets
	SetBlock
	MoveBlock
	Allocate
	Free
	FileLength
	ReadBlock
	]

external		// incoming and outgoing procedures
	[
	ReadFile
	WriteFile
	Font
	getname
	ReadUserCmItem		// from ReadUserCmItem.br
	]

external		// incoming OS statics
	[
	keys
	dsp
	]

external		// incoming statics
	[
	dcb
	systemdcb
	buffer
	zone
	menu
	stringlist
	boxnames
	highestname
	fontPtr
	]

static		// internal statics
	[
	NamesDefault=0
	TablesDefault=0
	]

structure PTR [
		blank word
		xmin word
		xmax word
		height word
		]


manifest anykey=#377


let WriteFile() be
	[
	// output the manifest file
	if menu!0 eq 0 then return
	Ws("*N*N*N*N*N*N")
	@#420=systemdcb
	if NamesDefault eq 0 then NamesDefault="MenuNames.d"
	let name=getname("Manifest file",NamesDefault)
	if name eq 0 then name=NamesDefault
	NamesDefault=name
	let s=OpenFile(name,ksTypeWriteOnly,charItem,verLatestCreate)
	Wss(s,"// ");Wss(s,name)
	Wss(s,"  --  Manifest names for menu windows.*N*N*N")
	Wss(s,"manifest*N*T[*N")
	let length=menu!0
	for n=1 to length do
		[
		Puts(s,$*T);Wss(s,boxnames!n);Puts(s,$=);Wns(s,n);Puts(s,$*N)
		]
	Wss(s,"*T]*N*N")
	Closes(s)

	// output the menu file
	// ask for name of file
	Ws("*N")
	if TablesDefault eq 0 then TablesDefault="MenuTables.bcpl"
	name=getname("Menu file",TablesDefault)
	if name eq 0 then name=TablesDefault
	TablesDefault=name
	s=OpenFile(name,ksTypeWriteOnly,charItem,verLatestCreate)

	// start the header
	Wss(s,"// ");Wss(s,name)
	Wss(s,"  --  Tables for setting up menu windows.*N*N*N")
	Wss(s,"external MenuInitHelp*N*N*N")
	Wss(s,"let MenuInitHelp() = valof*N*T[")

	// set up menu table
	Wss(s,"*N*T// set up menu table*N")
	Wss(s,"*Tlet menu=table*N*T*T[*N*T*T");Wns(s,length)
	for n=1 to (length+15)/16 do Wss(s,"*N*T*T0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0")
	Wss(s,"*N*T*T]*N")
	for n=1 to length do
		[
		Wss(s,"*Tmenu!");Wns(s,n);Wss(s,"=table [ 0;")
		Puts(s,$#);Wns(s,menu!n>>BOX.outline,0,8);Puts(s,$;)
		Wns(s,menu!n>>BOX.xorigin);Puts(s,$;)
		Wns(s,menu!n>>BOX.yorigin);Puts(s,$;)
		Wns(s,menu!n>>BOX.xcorner);Puts(s,$;)
		Wns(s,menu!n>>BOX.ycorner);Puts(s,$;)
		Puts(s,$#);Wns(s,menu!n>>BOX.controlflags,0,8);Wss(s," ]*N")
		]

	// set up stringlist table
	Wss(s,"*N*T// set up stringlist table*N")
	Wss(s,"*Tlet stringlist=table*N*T*T[*N*T*T");Wns(s,length)
	for n=1 to (length+15)/16 do Wss(s,"*N*T*T0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0")
	Wss(s,"*N*T*T]*N")
	for n=1 to length do
		[
		if stringlist!n eq 0 loop
		Wss(s,"*Tstringlist!");Wns(s,n)
		Wss(s,"=*"");Wss(s,stringlist!n);Wss(s,"*"*N")
		]

	// set up dcb table
	let dcbvec=MakeDCBChain()

	// now write this mess out
	let ptr=dcbvec+1
	Wss(s,"*N*T// set up menuDCB table*N")
	Wss(s,"*Tlet menuDCB=table*N*T*T[*N*T*T0*N")
	for n=0 to dcbvec!0-1 do
		[
		if ptr>>DCB.height ne 0 do
			[
			Wss(s,"*T*T0;#");Wns(s,ptr>>DCB.parwd,0,8)
			Wss(s,";0;");Wns(s,ptr>>DCB.height);Puts(s,$*N)
			]
		ptr=ptr+4
		]
	Wss(s,"*T*T]*N")
	Wss(s,"*Ttest (menuDCB&1) eq 1 ifso menuDCB=menuDCB+1*N")
	Wss(s,"*T*Tifnot for n=0 to ");Wns(s,4*dcbvec!0-1)
	Wss(s," do menuDCB!n=menuDCB!(n+1)*N")
	Wss(s,"*Tfor n=0 to ");Wns(s,dcbvec!0-2)
	Wss(s," do menuDCB!(4**n)=menuDCB+4**(n+1)*N")

	// now finish up
	Wss(s,"*N*T// now finish up*N")
	Wss(s,"*Tlet temp=table [ 0;0;0 ]*N")
	Wss(s,"*Ttemp!0=menu*N")
	Wss(s,"*Ttemp!1=stringlist*N")
	Wss(s,"*Ttemp!2=menuDCB*N")
	Wss(s,"*Tresultis temp*N*T]*N")
	Closes(s)
	]


and MakeDCBChain() = valof
	[
	// first calculate what dcb's are needed
	// use the buffer space for the screen, will be refreshed later
	let xmin=buffer
	let xmax=buffer+808
	SetBlock(xmin,800,808)
	Zero(xmax,808)
	for n=1 to menu!0 do		// scan over the menu
		[
		let box=menu!n
		let Xo=box>>BOX.xorigin
		let Xc=box>>BOX.xcorner
		for m=box>>BOX.yorigin to box>>BOX.ycorner do
			[
			xmin!m=Xo ls xmin!m ? Xo,xmin!m
			xmax!m=Xc gr xmax!m ? Xc,xmax!m
			]
		]

	// make lengths in words to identify tabs and widths
	for n=0 to 807 do
		[
		if xmin!n gr 606 then xmin!n=0
		xmin!n=xmin!n/16	// now equal to tab spacings
		xmax!n=(xmax!n+15)/16
		if xmax!n ge 38 then xmax!n=37
		]

	// start to set up the dcb's
	let dcbvec=xmax+808
	Zero(dcbvec,4*404+1)
	let oldflag=xmax!0 ? true,false
	let flag=0
	let ptr=dcbvec+1
	for n=0 to 403 do (ptr+4*n)>>PTR.xmin=800
	for n=0 to 807 do
		[
		flag=xmax!n ? true,false
		if (flag ne oldflag) then
			[
			dcbvec!0=dcbvec!0+1
			ptr=ptr+4
			oldflag=flag
			]
		if xmin!n ls ptr>>PTR.xmin then ptr>>PTR.xmin=xmin!n
		if xmax!n gr ptr>>PTR.xmax then ptr>>PTR.xmax=xmax!n
		ptr>>PTR.height=ptr>>PTR.height+1
		]
	dcbvec!0=dcbvec!0+1

	// dcb's have to have even # of lines
	let ptr=dcbvec+1
	for n=0 to dcbvec!0-1 do
		[
		if (ptr>>PTR.height & 1) eq 1 then
			[
			test ptr>>PTR.xmax
				ifso
				[
				ptr>>PTR.height=ptr>>PTR.height+1
				(ptr+4)>>PTR.height=(ptr+4)>>PTR.height-1
				]
				ifnot
				[
				ptr>>PTR.height=ptr>>PTR.height-1
				(ptr+4)>>PTR.height=(ptr+4)>>PTR.height+1
				]
			]
		ptr=ptr+4
		] 

	// scan through for zero height
	let olddcbvec=dcbvec
	let oldptr=olddcbvec+1
	dcbvec=olddcbvec+(4*410) //still higher in buffer
	let ptr=dcbvec+1
	dcbvec!0=0
	for n=0 to olddcbvec!0-1 do
		[
		if oldptr>>PTR.height ne 0 do
			[
			for i = 0 to 3 do
				[
				ptr!i=oldptr!i
				]
			dcbvec!0 = dcbvec!0+1
			ptr=ptr+4
			]
		oldptr=oldptr+4
		]

	// finish up the dcb chain
	let ptr=dcbvec+1
	for n=0 to dcbvec!0-1 do
		[
		ptr>>PTR.height=ptr>>PTR.height/2
		let xmax=ptr>>PTR.xmax
		let xmin=ptr>>PTR.xmin
		if xmax then xmax=2*((xmax-xmin)/2+1)
		if xmax+xmin gr 38 then xmin=xmin-1
		ptr>>PTR.xmin=(xmin lshift 8) + xmax	// tab, width
		ptr=ptr+4
		]
	resultis dcbvec
	]


and ReadFile() be
	[
	// read the manifest file
	Ws("*N*N*N*N*N*N")
	@#420=systemdcb
	if NamesDefault eq 0 then NamesDefault="MenuNames.d"
	let s1=nil
		[
		let name=getname("*NManifest file",NamesDefault)
		if name eq 0 then name=NamesDefault
		NamesDefault=name
		s1=OpenFile(name,ksTypeReadOnly,charItem,verLatest)
		] repeatuntil s1

	// read the menu file
	// ask for name of file
	let s2=nil
	if TablesDefault eq 0 then TablesDefault="MenuTables.bcpl"
		[
		let name=getname("*NMenu file",TablesDefault)
		if name eq 0 then name=TablesDefault
		TablesDefault=name
		s2=OpenFile(name,ksTypeReadOnly,charItem,verLatest)
		] repeatuntil s2

	// now free up all the space
	for n=1 to menu!0 do
		[
		if menu!n then Free(zone,menu!n)
		if stringlist!n then Free(zone,stringlist!n)
		if boxnames!n then Free(zone,boxnames!n)
		]
	Zero(menu,MaxLength)
	Zero(stringlist,MaxLength)
	Zero(boxnames,MaxLength)

	// now analyze the file
	// use the buffer space for the screen, will be refreshed later
	highestname=0
	let num=0
	let string=buffer
	let p=0
	until p eq $[ do p=Gets(s1)
		[
		p=ReadUserCmItem(s1,string)
		if p eq $E then break
		if p eq $P then if equalsSign(string) then
			[
			let c1=findsymbol(string,1,$=)
			let c2=string>>STRING.length
			if stringsequal(string,"box") then
				[
				num=getnum(string,4,c1)
				if num gr highestname then highestname=num
				]
			boxnames!(getnum(string,c1,c2))=getnam(string,1,c1-1)
			]
		] repeat
	Closes(s1)



	// now analyze the file
	// menu table
	let menulength=0
	until stringsequal(string,"menu!") do ReadUserCmItem(s2,string)
	while stringsequal(string,"menu!") do
		[
		let c1=findsymbol(string,1,$!)
		let c2=findsymbol(string,c1,$=)
		let number=getnum(string,c1,c2)
		menu!number=Allocate(zone,lBOX)
		if number gr menulength then menulength=number
		getmenunumbers(string,menu!number)
		ReadUserCmItem(s2,string)
		]

	// stringlist table
	until stringsequal(string,"stringlist!") do
		[ p=ReadUserCmItem(s2,string) ; if p eq $E break ]
	while stringsequal(string,"stringlist!") do
		[
		let c1=findsymbol(string,1,$!)
		let c2=findsymbol(string,1,$=)
		let c3=findsymbol(string,1,$")
		let c4=findsymbol(string,c3+1,$")
		stringlist!(getnum(string,c1,c2))=getnam(string,c3+1,c4-1)
		ReadUserCmItem(s2,string)
		]
	Closes(s2)

	// set menu, stringlist and boxnames counters
	@menu=menulength
	@stringlist=menulength
	@boxnames=menulength
	]


and equalsSign(string) = valof
	[
	for n=1 to string>>STRING.length do
		[ if string>>STRING.char↑n eq $= then resultis true ]
	resultis false
	]

and getnum(string,count1,count2) = valof
	[
	let number=0
	let octal=false
	for n=count1 to count2 do
		[
		let char=string>>STRING.char↑n
		if char eq $# then octal=true
		if (char ls $0) % (char gr $9) then loop
		number=(octal?8,10)*number+char-$0
		]
	resultis number
	]

and getnam(string,count1,count2) = valof
	[
	let count=1
	let letter=0
	let ptr=Allocate(zone,(count2-count1+1)/2+1)
	for n=count1 to count2 do
		[
		let char=string>>STRING.char↑n
		letter=letter+1
		ptr>>STRING.char↑letter=char
		]
	ptr>>STRING.length=letter
	resultis ptr
	]

and getmenunumbers(string,box) be
	[
	let count=findsymbol(string,1,$[)  //what does this do?
	let colon1=findsymbol(string,1,$;)
	let colon2=findsymbol(string,colon1+1,$;)
	let colon3=findsymbol(string,colon2+1,$;)
	let colon4=findsymbol(string,colon3+1,$;)
	let colon5=findsymbol(string,colon4+1,$;)
	let colon6=findsymbol(string,colon5+1,$;)
	box!0=dcb
	box!1=getnum(string,colon1,colon2)
	box!2=getnum(string,colon2,colon3)
	box!3=getnum(string,colon3,colon4)
	box!4=getnum(string,colon4,colon5)
	box!5=getnum(string,colon5,colon6)
	box!6=getnum(string,colon6,string>>STRING.length)
	]

and findsymbol(string,count,symbol) = valof
	[
	let length=string>>STRING.length
	until string>>STRING.char↑count eq symbol do count=count+1
	resultis count gr length ? length,count
	]

and stringsequal(string1,string2) = valof
	[
	for n=1 to string2>>STRING.length do
		[
		let char1=string1>>STRING.char↑n
		let char2=string2>>STRING.char↑n
		if char1 ne char2 resultis false
		]
	resultis true
	]


and Font() be
	[
	// read the font file
	Ws("*N*N*N*N*N*N")
	@#420=systemdcb
	let s=nil
		[
		let name=getname("*NFont file",0)
		if name eq 0 then [ fontPtr=0;return ]
		s=OpenFile(name,ksTypeReadOnly)
		] repeatuntil s

	// get the length
	let length=FileLength(s)
	fontPtr=GetFixed(length)
	if fontPtr eq 0 then
		[
		Ws("*NNot enough room for font.  Only have ")
		Wns(dsp,FixedLeft())
		Ws(" words left.   Type any char to continue.")
		Closes(s)
		Gets(keys)
		fontPtr=0
		return
		]

	// read the file
	Resets(s)
	ReadBlock(s,fontPtr,length)
	Closes(s)
	fontPtr=fontPtr+2
	]