// GLOOK.SR Format changes
get "BRAVO.DF"
get "CHAR.DF"
get "GINN.DF"
// Incoming procedures
external
[
getint
binsearcha
hpfree
getvch
putvch
mapscrcp
errhlt
stcopy
stnum
stappend
insertstring
deletea
move
movec
enww
readsel
stcompare
cpadjust2
invalidatedisplay
cppara
paracp
paraspec
gotparaspec
specstate
nextspecstate
makelist
enpspecs
gcspecs
freespec
ckspecs
cpadjustlist
parsespec
unparsespec
putscrwd
getscrwd
bubblesegs
setparaspec
setparacp
paradetails
parabounds
cpmin
cpmax
makespec
compactspec
cpc // %%
]
// Incoming statics
external
[
xleftmargstd
xrightmargstd
rgdlfirst
rgdllast
rgmaxdl
macww
rgdoc
vdoc
vcp
vchremain
rgmaccp
rgcpfdispl
rgcplast
vxleftmarg
vxrightmarg
cpscrt
vdlhint
vpara
rgpara
currentspec
rgdirty
rgfcode
vcpput
]
// Outgoing procedures
external
[
finishchanges
codechange
changeformata
receivechange
compatible
makeroominspec
setformata
]
// Outgoing Statics
external [
vlooksp
vlookcr
vlooktab
vlooktrailer
vlookmarker
vlookremark // $$
];
// Local
static [
vlooksp
vlookcr
vlooktab
vlooktrailer
vlookmarker
vlookremark // $$
];
let finishchanges(doc) be
[
let n = 0
enpspecs(unparsespec, doc)
for para = 0 to (rgpara ! doc) >> LIST.siz - 2 do
[
let mail = gotparaspec(doc, para)
if mail << odd then
[
if (n&7) eq 0 then gcspecs()
freespec(doc, para,
unparsespec(doc, para,
parsespec(doc, para, mail, true)))
n = n+1
]
]
]
and sendchange(newchange, doc, para1, para2) be
[
let change = vec changel
let oldchange = vec changel
let oldmail = -1
let newmail = nil
for para = para1 to para2 do
[
let spec = gotparaspec(doc, para)
if spec & not spec << odd then
[
changeformat(newchange, doc, para)
loop
]
if spec ne oldmail then
[
rgdirty ! doc = true
oldmail = spec
newmail = -1
test oldmail
ifso [
getmail(oldchange, oldmail)
if mergechanges(change,oldchange,newchange) then
newmail = oldmail
]
ifnot move(newchange, change, changel)
if newmail eq -1 then newmail = putmail(change)
]
setparaspec(doc, para, newmail)
]
]
and receivechange(mail, doc, para) be
[
unless mail do return
let change = vec changel
getmail(change, mail)
changeformat(change, doc, para)
]
and putmail(change) = valof
[
vcpput = cpscrt
if vcpput << odd then putvch(0)
let mail = vcpput + 1
for i = 0 to changel-1 do putscrwd(change ! i)
cpscrt = vcpput
resultis mail
]
and getmail(change, mail) be
[
vcp = mail - 1
for i = 0 to changel-1 do change ! i = getscrwd()
]
and codechange(change, char, value) = valof
[
let t = char ge $a? 1,0
let q = change + formatl
let fcode = 0 le char & char le 127? rgfcode ! char, -1
let w = fcode << FCODE.wordn
let b = fcode << FCODE.bitn
let m = #100000 rshift b
let un = fcode << FCODE.un
switchon fcode << FCODE.kind into
[
case klook:
q!w = q!w % m
change ! w = un? change!w & not m, change!w % m
endcase
case kquad:
q >> FORMAT.quad = true
change >> FORMAT.quad = un? 0, b
endcase
case knormal:
// %% change >> FORMAT.quad = 0
// %% q >> FORMAT.quad = true
change >> FORMAT.look = 0
q >> FORMAT.look = mlooks
// %% change >> FORMAT.dent = 0
// %% q >> FORMAT.dent = true
// %% change >> FORMAT.lmarg = 0
// %% q >> FORMAT.lmarg = true
// %% change >> FORMAT.rmarg = 0
// %% q >> FORMAT.rmarg = true
endcase
case kmeasure:
q!w = true
change!w = value
endcase
default: errhlt("UCC")
]
for i = 0 to nnumerics - 1 do if q ! i then resultis true
resultis false
]
and changeformata(change, doc, cp1, cp2) be
[
let para1, para2 = cppara(doc, cp1), cppara(doc, cp2)
test para1 eq para2
ifso changeformat(change, doc, para1, cp1,cp2)
ifnot [
changeformat(change, doc, para1, cp1)
sendchange(change, doc, para1+1, para2-1)
changeformat(change, doc, para2, 0, cp2)
]
]
and changeformat(change, doc, para, cp1, cp2 ; numargs N) be
[
makeroominspec(doc, para, paraspec(doc, para), 2)
let tex, b, e = nil, nil, nil
parabounds(doc, para, lv tex, lv b, lv e)
if N ls 4 then cp1 = tex // %%
if N ls 5 then cp2 = e // %%
if cpc(cp1, cp2) gr 0 then return // %%
let spec,siz,looks,changes,rcp1,r,rcp2,r2=nil,nil,nil,nil,nil,nil,nil,nil
paradetails(doc, para, lv spec, cpmax(cp1,tex), cpmin(cp2,b-1)) // %%
if cpc(rcp1, rcp2) le 0 then // %% cpc throughout
[
let newlook=changeformat1(lv change >> FORMAT.look, looks ! r)
if newlook ne looks ! r then
[
changedformat(doc, para, spec)
if cpc(changes ! r, rcp1) ls 0 then
[
siz = bubblesegs(siz, 1, r, changes, looks)
r = r + 1
changes ! r = rcp1
]
if cpc(changes ! (r+1), rcp2+1) gr 0 then
[
siz = bubblesegs(siz, 1, r, changes, looks)
changes ! (r+1) = rcp2+1
]
looks ! r = newlook
]
r = r + 1
] repeatuntil cpc(changes ! r, rcp2) gr 0
spec >> SPEC.siz = siz
let pnumeric = spec + firstformat + firstnumeric // %% even null para
for i = 0 to nnumerics - 1 do
[
let newnumeric = changeformat2(change + i, pnumeric ! i)
if newnumeric ne pnumeric ! i then
[
changedformat(doc, para, spec)
pnumeric ! i = newnumeric
]
]
compactspec(spec)
]
and changeformat1(change, now) =
now xor (change ! formatl & (now xor change ! 0))
and changeformat2(change, now) =
change ! formatl? change ! 0, now
and changedformat(doc, para, spec) be
[
spec >> SPEC.dirty = true
rgdirty ! doc = true
]
and makeroominspec(doc, para, spec, amt) = valof
[
let siz = spec >> LIST.siz
let lim = spec >> SPEC.max
if siz + amt le lim then resultis spec
let newlim = siz + amt + 2
let newspec = makespec(newlim)
spec = paraspec(doc, para)
let link = newspec >> SPEC.link
move(spec, newspec, specbase + siz)
move(spec+specbase+lim, newspec+specbase+newlim, siz)
newspec >> SPEC.link = link
setparaspec(doc, para, newspec)
newspec >> LIST.max = newlim
spec >> SPEC.doc = abandon
currentspec = 0
resultis newspec
]
and mergechanges(sum, old, new) = valof
[
for i = 0 to nnumerics - 1 do
[
let p = firstnumeric+i
let q = p+formatl
sum!q = true
test new!q
ifso sum!p = new!p
ifnot test old!q
ifso sum!p = old!p
ifnot sum!q = false
]
for i = 0 to nbinaries - 1 do
[
let p = firstbinary+i
let q = p+formatl
sum!q = old!q % new!q
sum!p = (old!p & not new!q) % new!p
]
for i = 0 to changel-1 do if sum!i ne old!i then resultis false
resultis true
]
and compatible(doc1, para1, doc2, para2) = valof
[
let spec1 = paraspec(doc1, para1)
let spec2 = paraspec(doc2, para2)
let pnumeric1 = spec1 + firstformat + firstnumeric
let pnumeric2 = spec2 + firstformat + firstnumeric
for i = 0 to nnumerics - 1 do
if pnumeric1 ! i ne pnumeric2 ! i then resultis false
resultis true
]
and setformata(doc, cp1, cp2, ch1, ch2, ch3, ch4, ch5;numargs N) be
[
let change = vec changel
movec(change, change + changel - 1, 0)
for i = 0 to N-4 do codechange(change, (lv ch1) ! i)
changeformata(change, doc, cp1, cp2)
]