// GPARA.SR	Paragraphs

get "BRAVO.DF"
get "CHAR.DF"
get "GINN.DF"

// Incoming procedures

external
	[
	cppara
	parabounds
	paradetails
	macpara
	gotparaspec
	setparaspec
	paracp
	paraspec
	setparacp
	getint
	binsearcha
	hpfree
	getvch
	putvch
	mapscrcp
	errhlt
	insertstring
	deletea
	hpalloca
	hpalloc
	move
	movec
	enww
	readsel
	stequal
	invalidatedisplay
	receivechange
	parsespec
	unparsespec
	min
	cpc
	makelist
	bubblesegs
	setpagenum
	setpagecp
	growlist
	updateofs
	inheap
	createdocm
	ckhp
	newsphp // %%
	freesphp // %%
	]

// Incoming statics

external
	[
	widthblave // $$
	xleftmargstd // $$
	xrightmargstd // $$
	rgdllast
// %% some names taken out to allow compilation
	vdoc
	vcp
	vchremain
	rgmaccp
	rgcpfdispl
	rgcplast
	vxleftmarg
	vxrightmarg
	vinsertk
	mdoc
	vlooktrailer
	rgpage
	rgpagenum
	rgreadonly
	rgchoppage
	rgupdate
	rgpctb
	rgsfile
	hdebug
	]

// Outgoing procedures

external
	[
	specstate
	nextspecstate
	enpspecs
	gcspecs
	freespec
	ckspecs
	wipedoc
	createdocp
	discardspecs
	acquirespecs
	replacespec
	forgetspec
	nulltrailer
	specdetails
	makespec
	discard
	bsearch
	ckspec
	trycpspec
	]

// Outgoing statics

external
	[
	vpara
	rgpara
	rgspec
	vlook
	vlookctrl
	vquad
	vchangemarker
	currentspec
	otherspec
	mphd
	rgprogram
	fdebug
	speclist
	vmakelock
	]


// Local statics

static
	[
	vpara
	rgpara
	rgspec
	vlook
	vlookctrl // strange-- maps chars gr #200 and ls #40
	vquad
	vchangemarker
	zcpfirst
	zcplast
	zspecinuse
	currentdoc
	currententry
	currentstart
	currentpara
	currentspec
	otherspec
	mphd
	rgprogram
	fdebug
	speclist
	cspecs
	vmakelock
	]

// Data Structures:
//	For each doc: rgpara!doc and rgspec!doc are "lists"
//	Each list has a prelude "listbase" words long with a "max" size
//		and a current "siz"
//	Then there is an entry for each paragraph, plus an entry for the
//		end-of-document paragraph (at !(siz-2)) and an entry
//		to stop the binary search (at !(siz-1))
//	rgpara has start cp's of each paragraph
//	rgspec has for each paragraph one of:
//		an even number -- ptr to heap structure for a "spec"
//		an odd number -- ptr to SCRATCH.TX mail for the para
//		zero -- neither of the above
//	each spec is a "list" with four parts after the prelude:
//		dirty bit, trailer length
//		paragraph wide format ("measures and quads")
//		local format changes ("looks")
//		relative cp's where looks occur ("changes")

let bsearch(list, key) = valof
[
let siz = list >> LIST.siz - 1
let i = binsearcha(list+listbase, siz, key)
unless 0 le i & i ls siz do errhlt("NSK")
resultis i
]

and specdetails(spec, vector) = valof
[
// To use:
// let siz,looks,changes = nil,nil,nil
// specdetails(spec, lv siz)
let siz = spec >> SPEC.siz
vector ! 0 = siz
vector ! 1 = spec + specbase		// looks
vector ! 2 = vector ! 1 + spec >> SPEC.max	// changes
resultis siz
]

and trycpspec(doc, cp) = valof
[
let para = cppara(doc, cp)
let w = (rgspec!doc) ! (para+listbase)
if w & not w << odd then resultis true
vmakelock = true
let spec = parsespec(doc, para, w)
vmakelock = false
resultis spec ne -1
]

and specstate(doc, cp, para) = valof
[
// Returns cp unless in hidden trailer, then returns beg of trailer cp
let tex, b, e = nil, nil, nil
parabounds(doc, para, lv tex, lv b, lv e)
let spec,siz,looks,changes,rcp,r = nil,nil,nil,nil,nil,nil
paradetails(doc, para, lv spec, cp)
currentpara = para
currentspec = spec
currententry = r
currentstart = tex
currentdoc = doc
// $$ vchangemarker = spec >> SPEC.dirty? 2, spec >> SPEC.marker? 1, 0
vchangemarker = spec >> SPEC.marker? 1, 0
vquad = spec >> SPEC.quad
let intrailer = r ge siz-2 & not vlooktrailer// %% 
// $$ vxleftmarg = rcp? spec >> SPEC.lmarg, spec >> SPEC.dent
vxleftmarg = xleftmargstd + spec >> SPEC.lmarg * widthblave
vxrightmarg = xrightmargstd - spec >> SPEC.rmarg * widthblave
// $$[
if vxleftmarg eq xleftmargstd & vxrightmarg eq xrightmargstd then
	resultis intrailer? b, cp // %%
vxleftmarg = vxleftmarg gr xrightmargstd? xrightmargstd,
		vxleftmarg ls xleftmargstd? xleftmargstd, vxleftmarg
vxrightmarg = vxrightmarg ls xleftmargstd? xleftmargstd,
		vxrightmarg gr xrightmargstd? xrightmargstd,
			vxrightmarg
if vxleftmarg gr vxrightmarg then 
	[
	vxleftmarg = (vxleftmarg+vxrightmarg)/2
	vxrightmarg = vxleftmarg
	]
if (vxrightmarg-vxleftmarg) ls (minline*widthblave) then
	[
	let adjust = ((minline*widthblave)-(vxrightmarg-vxleftmarg))/2
	vxleftmarg = vxleftmarg-adjust
	vxrightmarg = vxrightmarg+adjust
	if vxrightmarg gr xrightmargstd then
		[
		vxleftmarg = vxleftmarg - (vxrightmarg-xrightmargstd)
		vxrightmarg = xrightmargstd
		]
	if vxleftmarg ls xleftmargstd then
		[
		vxrightmarg = vxrightmarg + (xleftmargstd-vxleftmarg)
		vxleftmarg = xleftmargstd
		]
	]
// $$]
resultis intrailer? b, cp // %%
]

and nextspecstate() = valof
[
// Be sure specstate has been called to initiallize !
// Computes the format state and assigns it to statics such as vlook
// Returns the cp at which the next format changes occurs
// If encountered a trailer to be skipped, returns -1 & vcp -> CR
let siz,looks,changes = nil,nil,nil
specdetails(currentspec, lv siz)
vlook = looks ! currententry
if currententry ge siz-2 then
	[
// %%	vxleftmarg = xleftmargstd
// %%	vxrightmarg = xrightmargstd
	unless vlooktrailer do
		[
		vcp = currentstart + changes ! (siz-1) - 1
		resultis -1
		]
	]
currententry = currententry + 1
resultis currentstart + changes ! currententry  
]

and enpspecs(proc, doconly ; numargs N) be
[
// enpspecs(proc) calls proc(lv pspec) for all specs in all docs
//	TWICE -- once for speclist ptr and once for rgspec ptr
// enpspecs(proc, doc) calls proc(doc, para, spec) for all specs in
// 	doconly (or in all docs if doc=-1) ONCE
// proc is not allowed to destroy specs or add new ones !
// to do this use slowenpspecs
let p = lv speclist
let spec = speclist
let tsphp = newsphp(lv spec) // %%
while spec do
	[
	let doc = spec >> SPEC.doc
	let para = spec >> SPEC.para
	test N eq 1
	ifso	[
		let s = @p
		proc(p)
		if doc ne abandon then
			[
			let pp = (rgspec!doc)+(para+listbase)
			if @pp then
				[
				if s ne @pp then errhlt("ENP")
				proc(pp)
				]
			]
		]
	ifnot if doc ne abandon &
		(doc eq doconly % doconly eq -1) then
			proc(doc, para, spec)
	p = lv spec >> SPEC.link
	spec = @p
	]
freesphp(tsphp) // %%
]

and slowenpspecs(proc, doconly ; numargs N) be
[ // discard after ckspecs doesn't need it any more
// enpspecs(proc) calls proc(lv pspec) for all specs in all docs
// enpspecs(proc, doc) calls proc(doc, para, spec) for all specs in
// 	doconly (or in all docs if doc=-1)
// proc is allowed to destroy specs or add new ones
// if it doesn't need to, then use enpspecs instead
for doc = 0 to maxdoc-1 do if rgpara ! doc then
    if (N eq 1 % doc eq doconly % doconly eq -1) then
	for para = 0 to macpara(doc) - 2 do
		[
		let spec = gotparaspec(doc, para)
		unless spec & not spec << odd do loop
		test N eq 2
		ifso proc(doc, para, spec)
		ifnot proc((rgspec!doc)+(para+listbase))
		]
]

and gcspecs() be
    unless vinsertk do
	[
	if hdebug then ckhp()
	currentspec = speclist
	otherspec = 0
	while currentspec do
		[
		let doc = currentspec >> SPEC.doc
		let para = currentspec >> SPEC.para
		if fdebug & doc ne abandon then
			ckspec(doc, para, currentspec)
		let junk = doc eq abandon? true,
				gcspec(doc, para, currentspec)
		let nextspec = currentspec >> SPEC.link
		test junk
		ifso	[
			test otherspec
			ifso	otherspec >> SPEC.link = nextspec
			ifnot	speclist = nextspec
			if doc ne abandon then
				setparaspec(doc, para, 0)
			hpfree(currentspec)
			if hdebug then ckhp()
			]
		ifnot	otherspec = currentspec
		currentspec = nextspec
		]
	if fdebug then ckspecs()
	]

and gcspec(doc, para, spec) = valof
[
if para eq 0 % doc eq docsys % doc eq mdoc then resultis false
zspecinuse = false ;
zcpfirst = paracp(doc, para)
zcplast = paracp(doc, para+1) - 1
enww(isspecinuse, doc)
unless zspecinuse do
	[
	unparsespec(doc, para, spec)
	resultis true
	]
resultis false
]

and isspecinuse(ww) be
[
if cpc(zcplast, rgcpfdispl ! ww) ls 0 %
   (not rgupdate ! ww &
	cpc(zcpfirst, rgcplast ! (rgdllast ! ww)) gr 0)
		then return ;
zspecinuse = true ;
]

and freespec(doc, para, spec) be
[
spec >> SPEC.doc = abandon
setparaspec(doc, para, 0)
currentspec = 0
]

and wipefree(p, nilval; numargs N) be
	[
	if N eq 1 then nilval = 0
	if @p ne nilval then
		[
		if inheap(@p) then hpfree(@p)
		@p = nilval
		]
	]

and wipedoc(doc) be
[
enpspecs(freespec, doc)
wipefree(rgreadonly + doc)
wipefree(rgsfile + doc)
wipefree(rgpara + doc)
wipefree(rgspec + doc)
wipefree(rgpage + doc)
wipefree(rgpagenum + doc)
wipefree(rgpctb + doc, -1)
rgmaccp ! doc = 0;
updateofs()
createdocm(doc)
]

and ckspecs() be
	[
	cspecs = 0
	enpspecs(ckspec, -1)
	let tcspecs = cspecs
	cspecs = 0
	slowenpspecs(ckspec, -1)
	if cspecs ne tcspecs then errhlt("SPL")
	for doc = 0 to maxdoc-1 do if rgpara ! doc then
		[
		vdoc = doc
		for para = 1 to macpara(doc) - 2 do
			[
			vcp = paracp(doc, para)-1
			if cpc(vcp-paracp(doc,para-1), 1) ls 0 then
				errhlt("YIK")
			vchremain = 0
			if getvch() ne chcr then errhlt("MCR")
			]
		if rgprogram ! doc then
			unless (rgpara ! doc) >> LIST.siz le 3 &
    			    paraspec(doc, 0) >> SPEC.trailerlength eq 2
				do errhlt("fpr")
		]
	]

and ckspec(doc, para, spec) be
[
cspecs = cspecs + 1
if spec >> SPEC.doc ne doc % spec >> SPEC.para ne para then
	errhlt("DPS")
let v = rgpara ! doc
unless 0 le para & para ls v >> LIST.siz do errhlt("CSP")
let siz, looks, changes = nil, nil, nil
specdetails(spec, lv siz)
unless changes ! 0 eq 0 do errhlt("CS0")
for i = 1 to siz - 1 do
	if cpc(changes ! (i-1), changes ! i) ge 0 then
		errhlt("CSB")
if changes ! (siz-1) ne paracp(doc, para+1) - paracp(doc, para) %
  spec >> SPEC.trailerlength + changes ! (siz-2) ne changes ! (siz-1)
		then errhlt("PBE")
]

and createdocp(doc) be
[
rgpara ! doc = makelist(2, 1, listbase, false)
rgspec ! doc = makelist(2, 1, listbase, false)
rgpage ! doc = makelist(2, 1, listbase, false)
rgpagenum ! doc = makelist(2, 1, listbase, false)
rgreadonly ! doc = 0
rgprogram ! doc = false
rgchoppage ! doc = false
insertstring(doc, 0, "*032*N")
setparacp(doc, 1, rgmaccp ! doc)
setpagecp(doc, 1, rgmaccp ! doc)
setpagenum(doc, 1, 1)
]

and fixspecparas(doc, para1, para2) be
	for para = para1 to para2 do
		[
		let spec = gotparaspec(doc, para)
		if spec & not spec << odd then
			spec >> SPEC.para = para
		]

and discard(mac, p1, p2, rg1, rg2) be
[
let siz = bubblesegs(mac, p1-p2-1, p2+1, rg1 + listbase, rg2 + listbase)
rg1 >> LIST.siz = siz
rg2 >> LIST.siz = siz
]

and discardspecs(doc, para1, para2) be
	[
	discard(macpara(doc), para1, para2, rgpara!doc, rgspec!doc)
	fixspecparas(doc, para1, macpara(doc)-2)
	]

and acquirespecs(doc, para, nparas) be
[
growlist(rgpara+doc, nparas, 10, 1, listbase)
growlist(rgspec+doc, nparas, 10, 1, listbase)
bubblesegs(macpara(doc) - nparas, nparas, para,
	rgpara!doc + listbase, rgspec!doc + listbase)
fixspecparas(doc, para+nparas, macpara(doc)-2)
]

and replacespec(doc, para, spec) be
[
currentspec = 0
let oldspec = paraspec(doc, para)
if oldspec then
	[
	spec >> SPEC.trailerlength = oldspec >> SPEC.trailerlength
	let siz, looks, changes = nil, nil, nil
	specdetails(spec, lv siz)
	changes ! (siz-1) = changes ! (siz-2) +
		spec >> SPEC.trailerlength
	oldspec >> SPEC.doc = abandon
	]
setparaspec(doc, para, spec)
]

and forgetspec(doc, para) be
[
let spec = (rgspec!doc)!(para+listbase)
if spec & not spec << odd then spec >> SPEC.doc = abandon
(rgspec!doc)!(para+listbase) = 0
currentspec = 0
]

and makespec(lim, okrobdisplay; numargs N) = valof
	[ // okrobdisplay defaults to true
	let spec = makelist(lim, 2, specbase,
		N eq 1 % okrobdisplay)
	if spec eq 0 then errhlt("SPZ")
	spec >> SPEC.doc = abandon
	spec >> SPEC.link = speclist
	speclist = spec
	resultis spec
	]