-- SpacingImpl.mesa
-- Last Edited by: Maxwell, November 18, 1983 3:45 pm

DIRECTORY
	Event USING [Adjust, Clef, Grace, Invisible, KeySignature, Measure, SetStave, Staves, Sync], 
	Inline USING [LowHalf], 
	MusicDefs, 
	Note USING [Delta, Duration, GetBackTie, Width], 
	Piece USING [NearestEvent, Overflow], 
	Real USING [Fix], 
	Score USING [GetAccidental, GetKey, GetMetrenome], 
	Selection USING [AddLine], 
	Sheet USING [FindSection, FindStaves, FindLine, Height, Reset], 
	Voice USING [ClearState, Correct, max, SetState, State, StatePTR];

SpacingImpl: PROGRAM 
	IMPORTS Event, Inline, MusicDefs, Note, Piece, Real, Score, Selection, Sheet, Voice
	EXPORTS Score = 
BEGIN
OPEN MusicDefs;

Error: SIGNAL = CODE;

ts: PUBLIC TimeSignature;

ScalePhysical: PUBLIC PROCEDURE[score: ScorePTR, n: INTEGER] = 
BEGIN
sync: SyncPTR;
end, delta: Time ← 0;
IF n < 0 THEN RETURN;
score.sheet.display ← physical;
score.sheet.density ← n;
FOR i: CARDINAL IN [0..score.length) DO
	IF score[i] = NIL THEN LOOP;
	IF score[i].type = staves AND score[i].time < 5 THEN {score[i].time ← -1; LOOP};
	score[i].time ← 0;
	sync ← IF score[i].type = sync THEN Event.Sync[score[i]] ELSE NIL;
	IF sync # NIL THEN FOR j: CARDINAL IN [0..sync.length) DO
		IF sync.note[j] = NIL THEN EXIT;
		IF sync.note[j].duration = 0 THEN LOOP; 
		IF sync.note[j].toc = 0 THEN LOOP; 
		sync.time ← sync.note[j].toc/n+delta;
		IF sync.time < end THEN delta ← end+10-sync.time;
		IF sync.time < end THEN sync.time ← end+10;
		EXIT; ENDLOOP;
	end ← MAX[end, score[i].time];
	ENDLOOP;
IF score.length = 0 THEN RETURN;
IF score[score.length-1].time = 0 THEN score[score.length-1].time ← end+20;
FOR i: CARDINAL DECREASING IN [0..score.length-1) DO
	IF score[i].time # 0 THEN LOOP;
	IF score[i].type = measure THEN score[i].time ← score[i+1].time-3 -- IN [measure..endMeasure]
				ELSE score[i].time ← score[i+1].time;
	ENDLOOP; 
END;

LogicalToPhysical: PUBLIC PROCEDURE[score: ScorePTR, begin, end: Time] = 
BEGIN
sync: SyncPTR;
ss: Voice.State;
sum, max, delta, maxDuration, duration, lastSum: Time ← 0;
metrenome: INTEGER;
n: NotePTR;
Voice.ClearState[@ss];
sum ← 256*8;
FOR i: CARDINAL IN [0..Voice.max) DO ss[i].sum ← sum; ENDLOOP;
metrenome ← Score.GetMetrenome[score, 0];
FOR i: CARDINAL IN [0..score.length) DO
	IF score[i].time < begin THEN LOOP;
	IF score[i].time > end THEN EXIT;
	IF score[i].type = metrenome THEN WITH ev: score[i] SELECT FROM
		metrenome => metrenome ← ev.metrenome; 
		ENDCASE => ERROR;
	IF score[i].type # sync THEN LOOP;
	sync ← Event.Sync[score[i]];
	max ← Voice.SetState[@ss, sync, metrenome];
	IF max < sum THEN sum ← sum + maxDuration ELSE sum ← max;
	FOR j: CARDINAL IN [0..Voice.max) DO 
		IF ss[j].found THEN ss[j].sum ← sum; ENDLOOP;
	-- ***test for special case: physical notes in logical score
	maxDuration ← 0;
	FOR j: CARDINAL IN [0..Voice.max) DO
		IF ss[j].found THEN maxDuration ← MAX[maxDuration, ss[j].duration];
		ENDLOOP;
	IF maxDuration = 0 THEN -- no logical notes in sync 
		BEGIN
		toc: Time ← duration ← 0;
		FOR j: CARDINAL IN [0..sync.length) DO
			IF (n ← sync.note[j]) = NIL THEN EXIT;
			toc ← MAX[toc, n.toc];
			duration ← MAX[duration, n.duration];
			ENDLOOP;
		sum ← toc + delta; -- use offset and play physically
		FOR j: CARDINAL IN [0..Voice.max) DO 
			ss[j].sum ← MAX[ss[j].sum, sum+duration]; 
			ENDLOOP;
		END;
	FOR j: CARDINAL IN [0..sync.length) DO
		IF (n ← sync.note[j]) = NIL THEN EXIT;
		IF n.toc # 0 THEN delta ← sum-n.toc;
		IF n.value # unknown THEN n.duration ← Duration[score, n, metrenome];
		n.toc ← lastSum ← sum; 
		ENDLOOP;
	ENDLOOP;
END;
	 
Duration: PROCEDURE[score: ScorePTR, n: NotePTR, metrenome: INTEGER] RETURNS[INTEGER] = 
BEGIN
l: REAL ← 1;
tie: NotePTR ← n;
d: LONG INTEGER ← Note.Duration[n, metrenome];
WHILE tie.tied DO
	IF tie.embellish = trill THEN EXIT;
	tie ← Note.GetBackTie[score, tie];
	d ← MIN[d + Note.Duration[tie, metrenome], 32000];
	ENDLOOP;
RETURN[Inline.LowHalf[7*(d/8)]];
END;

	
-- ****************************************************************************
-- justification of the score
-- ****************************************************************************

Justify: PUBLIC PROCEDURE[score: ScorePTR, begin, end: Time] = 
BEGIN ENABLE Piece.Overflow => IF score = old THEN score ← new;
i: CARDINAL;
one, s: REAL ← 1;
key: INTEGER ← 0;
shorten: BOOLEAN ← FALSE;
lineBegin, lineEnd, delta, unjustifiedTime: Time ← 0;
firstML, lastML, ML1, ML2: CARDINAL ← 0;
-- begin ← select1;
-- end ← select2;
IF score[0] = NIL THEN RETURN;
IF begin >= end THEN {score.flash ← TRUE; RETURN};
[firstML, lastML] ← SelectMeasures[score, begin, end];
Voice.Correct[score, score[firstML].time, score[lastML].time];
[firstML, lastML] ← SelectMeasures[score, begin, end]; -- may have changed
IF firstML = lastML THEN lastML ← score.length-1;
key ← Score.GetKey[score, score[firstML].time];
lineBegin ← score.sheet[Sheet.FindLine[score.sheet, score[firstML].time+1]].time-1;
ShowLogical[score, firstML, lastML];
unjustifiedTime ← score[firstML].time;
i ← ML1 ← ML2 ← firstML;
DO i ← i+1; IF i > lastML THEN EXIT;  -- FOR i: CARDINAL IN (firstML..lastML] DO
	IF ML1 = i-1 THEN { -- initialize
		-- 'delete' hidden syncs (if any)
		delta ← 0;
		IF score[ML2].time = lineBegin OR ML2 = 0 THEN FOR j: CARDINAL IN [i..score.length) DO
			IF (score[j].type = sync OR Measure[score[j]]) AND delta = 0 THEN EXIT;  -- no leading signature
			score[j].time ← score[j].time-delta;
			IF score[j].type = keySignature AND delta = 0 THEN { 
				IF j > lastML THEN EXIT;
				IF ~Event.Invisible[score, j, unjustifiedTime] THEN EXIT; 
				key ← Event.KeySignature[score[j]].key; 
				delta ← ABS[key*8]; LOOP};
				-- score[j].time ← unjustifiedTime+5;  so it won't get drawn 
			ENDLOOP;
		lineEnd ← lineBegin+score.sheet.width-MAX[ABS[key*8], 8]}; -- end initialization
	IF score[i].type = keySignature THEN key ← Event.KeySignature[score[i]].key;
	IF NOT Measure[score[i]] THEN LOOP;
	SELECT TRUE FROM  -- have we found the end of the line?
		i = 0 => LOOP;
		i = lastML => ML2 ← i;
		score[i].type = staves => ML2 ← i;
		score[i].time-unjustifiedTime < lineEnd-lineBegin => {ML2 ← i; LOOP};
		score[i].time-unjustifiedTime = lineEnd-lineBegin => ML2 ← i;
		ENDCASE ;
	-- we've hit the end of a line, try to justify.
	IF ML1 = ML2 AND score[ML1].time # lineBegin THEN {-- start on the next line
		delta ← lineEnd-score[ML1].time;
		FOR j: CARDINAL IN [ML1..score.length) DO
			score[j].time ← score[j].time+delta;
			ENDLOOP;
		lineBegin ← lineEnd;
		i ← ML2; -- back up (this is why the iteration is so strange)
		LOOP};
	IF ML1 = ML2 THEN {-- the measure's too big to fit on one line!!
		lineEnd ← lineBegin+score.sheet.width - MAX[ABS[key*8], 8];
		LOOP};
	-- stretch the measures in [ML1..ML2] over the area [lineBegin..lineEnd]
	IF score[ML2].time = score[ML1].time THEN LOOP;
	s ← one*(lineEnd-score[ML1].time)/(score[ML2].time-unjustifiedTime);
	IF s > 2 AND ML2 = score.length-1 AND score[ML2].type # staves THEN {s ← MIN[s, 2]; shorten ← TRUE};
	IF s > 10 THEN s ← 1; -- for empty lines
	FOR j: CARDINAL IN (ML1..ML2) DO
		score[j].time ← Real.Fix[(score[j].time-unjustifiedTime)*s+score[ML1].time];
		ENDLOOP;
	IF shorten 
		THEN score[ML2].time ← ((score[ML2].time-unjustifiedTime)*2+score[ML1].time)
		ELSE {unjustifiedTime ← score[ML2].time; score[ML2].time ← lineEnd};
	lineBegin ← lineEnd;
	ML1 ← ML2;
	i ← ML2; -- back up (this is why the iteration is so strange)
	ENDLOOP;
-- shift everything else over to the right
delta ← score[lastML].time-unjustifiedTime;
FOR i: CARDINAL IN (lastML..score.length) DO
	score[i].time ← score[i].time+delta;
	ENDLOOP;
-- set up selection
Sheet.Reset[score];
Selection.AddLine[score, score[firstML].time+1, score[lastML].time-1];
END;

SelectMeasures: PROC[score: ScorePTR, t1, t2: Time] RETURNS[s1, s2: CARDINAL] = 
BEGIN
m: CARDINAL;
delta: Time ← 10000;
s1 ← s2 ← 0;
m ← Piece.NearestEvent[score, t1];
FOR i: CARDINAL DECREASING IN [0..m] DO
	IF NOT Measure[score[i]] THEN LOOP;
	delta ← ABS[score[m].time - score[i].time];
	s1 ← i; EXIT; ENDLOOP;
IF t1 < delta THEN {s1 ← 0; delta ← t1}; -- include beginning
FOR i: CARDINAL IN [m..score.length) DO
	IF NOT Measure[score[i]] THEN LOOP;
	IF score[i].time >= t2 THEN EXIT;
	IF ABS[score[i].time-score[m].time] < delta THEN s1 ← i;
	EXIT; ENDLOOP;
delta ← 10000;
m ← Piece.NearestEvent[score, t2];
FOR i: CARDINAL DECREASING IN [0..m] DO
	IF NOT Measure[score[i]] THEN LOOP;
	IF score[i].time <= t1 THEN EXIT;
	delta ← ABS[score[m].time-score[i].time];
	s2 ← i; EXIT; ENDLOOP;
FOR i: CARDINAL IN [m..score.length) DO
	IF NOT Measure[score[i]] THEN LOOP;
	IF ABS[score[i].time-score[m].time] < delta THEN s2 ← i;
	EXIT; ENDLOOP;
IF s1 > s2 THEN s2 ← s1; -- no measure
END;
	
ShowLogical: PUBLIC PROCEDURE[score: ScorePTR, firstEvent, lastEvent: CARDINAL] = 
BEGIN
ss: Voice.State;
prior: CARDINAL;
staves: EventRec.staves;
delta, endTime, break: Time;
sheet: SheetPTR ← score.sheet;
lastTime ← 0;
Voice.ClearState[@ss];
vs ← ALL[0]; ps ← ALL[0];
IF score.sheet.display = physical THEN score.sheet.density ← 3;
IF score.sheet.density > 30 THEN score.sheet.density ← 3;
score.sheet.display ← graphical;
IF firstEvent = 0 THEN score[0].time ← 0;
endTime ← score[lastEvent].time;
break ← score[firstEvent].time;
[] ← Voice.SetState[@ss, score[firstEvent]];
-- set up sheet
staves ← Sheet.FindStaves[sheet, score[firstEvent].time]↑;
sheet[0].time ← 0;
FOR i: CARDINAL IN [1..sheet.length) DO
	sheet[i].time ← 1000000;
	ENDLOOP;
-- layout the selected section
prior ← firstEvent;
SetBackState[score, @ps, score[firstEvent]];
FOR i: CARDINAL IN (firstEvent..lastEvent] DO
	IF score[i].type = sync THEN Event.Adjust[score, Event.Sync[score[i]]];
	score[i].time ← score[prior].time+1;
	IF Event.Clef[score[i]] AND Event.Invisible[score, i, break] 
		THEN score[i].time ← score[prior].time+1
		ELSE {
			score[i].time ← Distance[score, score[prior], score[i], @ss]; 
			prior ← i; SetBackState[score, @ps, score[i]]}; 
	IF score[i].type = staves THEN break ← score[i].time;
	IF score[i].type = keySignature THEN sheet[0].key ← Event.KeySignature[score[i]].key;
	IF score[i].type # staves THEN LOOP;
	Event.SetStave[score, @staves, Event.Staves[score[i]]];
	staves ← Event.Staves[score[i]]↑;
	sheet[0].staves ← @staves;
	ENDLOOP;
-- move the rest of the score to the right
delta ← score[lastEvent].time - endTime;
FOR i: CARDINAL IN (lastEvent..score.length) DO
	score[i].time ← score[i].time + delta;
	ENDLOOP;
IF test THEN FOR i: CARDINAL IN [1..score.length) DO
	IF score[i].time < score[i-1].time THEN Error;
	ENDLOOP;
END;

lastTime: Time;
vs: VoiceOffset;
ps: OffsetState;

Distance: PROCEDURE[score: ScorePTR, a, b: EventPTR, ss: Voice.StatePTR] RETURNS[Time] = 
BEGIN
n: NotePTR;
d: INTEGER;
acc: Accidental;
related: BOOLEAN ← FALSE;
oldss: Voice.State ← ss↑;
time, toc, max, start: Time ← 0;
i, j, height, up, down: CARDINAL ← 0;
-- minimum distance based on voices
max ← Voice.SetState[ss, b, 128, FALSE];
IF b.type = sync AND Event.Grace[Event.Sync[b]] THEN max ← max+10; -- move to the following note's max
FOR j: CARDINAL IN [0..Voice.max) DO
	IF oldss[j].found THEN vs[j] ← a.time;
	IF oldss[j].found AND ss[j].found THEN related ← TRUE;
	ENDLOOP;
IF a.type # sync OR b.type # sync THEN related ← TRUE; 
toc ← max-lastTime;
IF NOT related THEN BEGIN 
	mod: Time ← toc MOD 256;
	IF mod < 0 THEN mod ← mod+256;
	IF mod < 2 OR mod > 254 THEN related ← TRUE;
	END;
IF NOT related THEN FOR j: CARDINAL IN [0..Voice.max) DO
	IF NOT ss[j].found THEN LOOP;
	IF start > vs[j] THEN LOOP;
	toc ← max-oldss[j].sum;
	start ← vs[j];
	ENDLOOP;
IF related THEN start ← a.time;
IF b.type = sync OR (a.type = sync AND Measure[b]) THEN 
	SELECT TRUE FROM
	a.type = sync AND Event.Grace[Event.Sync[a]] => time ← start+6+score.sheet.density/2;
	toc > 12000 => time ← start+10+20*score.sheet.density; 
	toc > 6000  => time ← start+8+12*score.sheet.density; 
	toc > 3000  => time ← start+8+8*score.sheet.density; 
	toc > 1500  => time ← start+8+4*score.sheet.density; 
	toc > 750   => time ← start+8+2*score.sheet.density;
	ENDCASE => time ← start+8+score.sheet.density;
lastTime ← max;
-- interaction with graphical objects
IF Event.Clef[a] AND Event.Clef[b] THEN RETURN[a.time];
IF b.type = sync THEN FOR i: CARDINAL IN [0..Event.Sync[b].length) DO
	IF (n ← Event.Sync[b].note[i]) = NIL THEN EXIT;
	height ← Index[Sheet.Height[score.sheet, time+1, n.pitch, n.staff]];
	IF NOT score.sheet.accidental THEN d ← 2
		ELSE SELECT (acc ← Score.GetAccidental[score, n]) FROM
			inKey => d ← 2;
			doubleFlat => d ← 17;
			ENDCASE => d ← 12;
	IF score.sheet.display = graphical THEN d ← d- Note.Delta[score.sheet, n]- n.accDelta;
	-- IF Note.Delta[n] < 0 THEN time ← MAX[time, a.time+4-Note.Delta[n]];
	-- find interactions with the note head
	IF ~n.rest THEN {up ← 1; down ← 1} ELSE SELECT n.value FROM
		quarter => {up ← 3; down ← 3};
		eighth => {up ← 3; down ← 3};
		sixteenth => {up ← 3; down ← 3};
		thirtysecond => {up ← 3; down ← 3};
		ENDCASE => {up ← 0; down ← 0};
	up ← MIN[height+up+1, off];
	down ← MAX[height, down]-down;
	FOR j: CARDINAL IN [down..up) DO
		time ← MAX[time, ps[j]+d];
		ENDLOOP;
	IF n.rest THEN LOOP;  
	-- find interactions with the accidental not handled above
	IF score.sheet.accidental THEN SELECT acc FROM
		sharp, natural => FOR j: CARDINAL IN [MAX[height, 3]-3..MIN[height+4, off]) DO
					IF j IN [height-1..height+1] THEN LOOP;
					time ← MAX[time, ps[j]+d];
					ENDLOOP;
		flat, doubleFlat => 
				FOR j: CARDINAL IN [MIN[height+2, off-1]..MIN[height+6, off]) DO
					time ← MAX[time, ps[j]+d];
					ENDLOOP;
		ENDCASE; 
	-- find interactions with the ledger lines
	d ← Note.Delta[score.sheet, n]+5;
	FOR i: CARDINAL IN [Index[score.sheet[0].staves.staff[n.staff].y+40]..height] DO
		time ← MAX[time, ps[i]+d];
		ENDLOOP;
	FOR i: CARDINAL IN [height..Index[score.sheet[0].staves.staff[n.staff].y-8]] DO
		time ← MAX[time, ps[i]+d];
		ENDLOOP;
	-- find interactions with the stem
	IF n.stemUp	
	THEN FOR j: CARDINAL IN (height..MIN[height+9, off]) DO
		 time ← MAX[time, ps[j]-8]; ENDLOOP
	ELSE FOR j: CARDINAL IN [MAX[height, 8]-8..height) DO
		 time ← MAX[time, ps[j]]; ENDLOOP;
	ENDLOOP;
SELECT TRUE FROM
	Measure[b] => BEGIN
		FOR i: CARDINAL IN [0..off) DO time ← MAX[time, ps[i]]; ENDLOOP;
		FOR i: CARDINAL IN [0..Voice.max) DO time ← MAX[time, vs[i]+4]; ENDLOOP;
		IF a.type = sync 
			THEN IF b.type = staves 
				THEN time ← time + 6 
				ELSE time ← time+ measure[Event.Measure[b].measure]
			ELSE time ← time+3;
		END;
	b.type = sync => NULL;
	b.type = staves => BEGIN -- clef, octava1, octava2
		FOR i: CARDINAL IN [0..off) DO time ← MAX[time, ps[i]]; ENDLOOP;
		time ← time+3;
		END;
	ENDCASE => BEGIN
		FOR i: CARDINAL IN [0..off) DO time ← MAX[time, ps[i]]; ENDLOOP;
		END;
IF Measure[a] AND Measure[b] THEN time ← a.time+100;
IF a.type = measure AND b.type = staves THEN -- IF a.type IN EventType[repeat1..m5]
	IF Event.Measure[a].measure # measure AND Event.Staves[b].staves = style THEN RETURN[a.time]; 
RETURN[MAX[time, a.time+4]];
END;

SetBackState: PROCEDURE[score: ScorePTR, ps: POINTER TO OffsetState, s: EventPTR] = 
BEGIN
n: NotePTR;
width: Time ← 0;
offset: CARDINAL;
here: Time ← s.time;
key: INTEGER ← Score.GetKey[score, s.time];
top, bottom: CARDINAL;
-- handle note events
IF s.type = sync THEN FOR i: CARDINAL IN [0..Event.Sync[s].length) DO
	IF (n ← Event.Sync[s].note[i]) = NIL THEN EXIT;
	IF score.sheet.display = graphical THEN here ← Note.Delta[score.sheet, n]+s.time;  
	offset ← Index[Sheet.Height[score.sheet, s.time, n.pitch, n.staff]];
	-- fill in for the note head
	width ← Note.Width[n];
	IF n.rest AND n.value IN [eighth..sixteenth] THEN width ← 12;
	IF n.dotted THEN width ← width+8;
	ps[offset] ← MAX[ps[offset], here+width];
	IF n.rest THEN LOOP;
	-- fill in for ledger lines
	width ← Note.Width[n]+3;
	FOR i: CARDINAL IN [Index[score.sheet[0].staves.staff[n.staff].y+40]..offset] DO
		ps[i] ← MAX[ps[i], here+width];
		ENDLOOP;
	FOR i: CARDINAL IN [offset..Index[score.sheet[0].staves.staff[n.staff].y-8]] DO
		ps[i] ← MAX[ps[i], here+width];
		ENDLOOP;
	-- fill in for stems and flags
	IF n.value = whole OR n.value = unknown THEN LOOP;
	IF n.stemUp THEN { 
		width ← Note.Width[n];
		IF n.value > quarter AND (n.beam = NIL OR NOT n.beam.beamed) THEN width ← 14;
		IF width = 14 AND n.grace THEN width ← 10; 
		FOR j: CARDINAL IN (offset..MIN[offset+8, off]) DO 
			ps[j] ← MAX[ps[j], here+width]; 
			ENDLOOP}
	ELSE { 
		IF n.value > quarter AND (n.beam = NIL OR NOT n.beam.beamed) 
			THEN width ← 6 ELSE width ← 0; 
		IF width = 6 AND n.grace THEN width ← 4; 
		FOR j: CARDINAL IN [MAX[offset, 7]-7..offset) DO 
			ps[j] ← MAX[ps[j], here+width]; 
			ENDLOOP};
	ENDLOOP;
IF s.type = sync THEN RETURN;
-- handle all non-note events
top ← Index[0];
bottom ← Index[Sheet.Height[score.sheet, s.time, , 3]];
WITH ev: s SELECT FROM
	metrenome => RETURN; -- {top ← bottom ← Index[Sheet.Height[s.time, , 0]+44]; width ← 20};
	timeSignature => width ← 14;
	keySignature => width ← 8*ABS[key];
	measure => width ← measure[ev.measure];
	staves => IF ev.staves = style THEN width ← 6 ELSE {
		bottom ← Index[Sheet.Height[score.sheet, s.time, , ev.value]];
		top ← bottom+10;
		width ← 20}
	ENDCASE => RETURN;
top ← MIN[top, off-1];
bottom ← MIN[bottom, off-1];
FOR i: CARDINAL IN [bottom..top] DO ps[i] ← s.time+width; ENDLOOP;
END;

SetVoiceOffset: PROCEDURE[vs: POINTER TO VoiceOffset, s: SyncPTR] = 
BEGIN
d: INTEGER;
v: CARDINAL;
FOR i: CARDINAL IN [0..s.length) DO
	IF s.note[i] = NIL THEN EXIT;
	v ← s.note[i].voice;
	d ← value[s.note[i].value]+(IF s.note[i].value = whole THEN 10 ELSE 8);
	IF s.note[i].dotted AND d < 12 THEN d ← d+4;
	IF vs[v] > s.time THEN vs[v] ← MIN[vs[v], s.time+d]
	 		ELSE vs[v] ← s.time+d;
	ENDLOOP;
END;

value: ARRAY NoteValue OF CARDINAL ← [32, 16, 8, 4, 2, 1, 1, 1];

measure: ARRAY MeasureType OF CARDINAL ← [6, 12, 12, 12, 8, 6];

Index: PROCEDURE[height: INTEGER] RETURNS[CARDINAL] = 
  {RETURN[LOOPHOLE[MAX[70+height/4, 0]]]};
off: CARDINAL = 100;
OffsetState: TYPE = ARRAY [0..off) OF Time;
VoiceOffset: TYPE = ARRAY[0..10) OF Time;

test: BOOLEAN ← FALSE;
END.