-- Author: John Maxwell
-- last modified: December 14, 1981 11: 13 AM

DIRECTORY
 Inline USING [LowHalf],
 MusicDefs,
 Note USING [Delta, Duration, GetBackTie, Width],
 Piece USING [NearestSync],
 Real USING [Fix],
 Score USING [GetAccidental, GetKey, GetMetrenome],
 Selection USING [AddLine],
 Sheet USING [FindSection, FindLine, Height, Reset],
 Sync USING [Adjust, Grace, Hidden, SetStave],
 Voice USING [ClearState, Correct, SetState, State, StatePTR];

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

Error: SIGNAL = CODE;

ts: PUBLIC TimeSignature;

ScalePhysical: PUBLIC PROCEDURE[n: INTEGER] =
BEGIN
end, delta: Time ← 0;
i, j: CARDINAL;
IF n < 0 THEN RETURN;
show.display ← physical;
TF ← n;
FOR i IN [0..scoreLength) DO
 IF score[i] = NIL THEN LOOP;
 IF score[i].type IN SheetSwitch AND score[i].time < 5 THEN {score[i].time ← -1; LOOP};
 score[i].time ← 0;
 FOR j IN [0..syncLength) DO
  IF score[i].event[j] = NIL THEN EXIT;
  IF score[i].event[j].duration = 0 THEN LOOP;
  IF score[i].event[j].toc = 0 THEN LOOP;
  score[i].time ← score[i].event[j].toc/n+delta;
  IF score[i].time < end THEN delta ← end+10-score[i].time;
  IF score[i].time < end THEN score[i].time ← end+10;
  EXIT;
  ENDLOOP;
 end ← MAX[end, score[i].time];
 ENDLOOP;
IF scoreLength = 0 THEN RETURN;
IF score[scoreLength-1].time = 0 THEN score[scoreLength-1].time ← end+20;
FOR i DECREASING IN [0..scoreLength-1) DO
 IF score[i].time # 0 THEN LOOP;
 IF score[i].type IN [measure..endMeasure] THEN score[i].time ← score[i+1].time-3
    ELSE score[i].time ← score[i+1].time;
 ENDLOOP;
END;

LogicalToPhysical: PUBLIC PROCEDURE[begin, end: Time] =
BEGIN
i, j: CARDINAL;
ss: Voice.State;
sum, max, delta, maxDuration, duration, lastSum: Time ← 0;
metrenome: INTEGER;
n: NotePTR;
Voice.ClearState[@ss];
sum ← 256*8;
FOR i IN [0..maxVoice] DO ss[i].sum ← sum; ENDLOOP;
metrenome ← Score.GetMetrenome[0];
FOR i IN [0..scoreLength) DO
IF score[i].time < begin THEN LOOP;
IF score[i].time > end THEN EXIT;
IF score[i].type = metrenome THEN metrenome ← score[i].value;
IF score[i].type # notes THEN LOOP;
max ← Voice.SetState[@ss, score[i], metrenome];
IF max < sum THEN sum ← sum + maxDuration ELSE sum ← max;
FOR j IN [0..maxVoice] DO IF ss[j].found THEN ss[j].sum ← sum; ENDLOOP;
-- ***test for special case: physical notes in logical score
maxDuration ← 0;
FOR j IN [0..maxVoice] 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 IN [0..syncLength) DO
IF (n ← score[i].event[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 IN [0..maxVoice] DO
  ss[j].sum ← MAX[ss[j].sum, sum+duration];
  ENDLOOP;
END;
FOR j IN [0..syncLength) DO
 IF (n ← score[i].event[j]) = NIL THEN EXIT;
 IF n.toc # 0 THEN delta ← sum-n.toc;
 IF n.value # unknown THEN n.duration ← Duration[n, metrenome];
 n.toc ← lastSum ← sum;
 ENDLOOP;
ENDLOOP;
END;

Duration: PROCEDURE[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[tie];
 d ← MIN[d + Note.Duration[tie, metrenome], 32000];
 ENDLOOP;
RETURN[Inline.LowHalf[7*(d/8)]];
END;


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

Justify: PUBLIC PROCEDURE[begin, end: Time] =
BEGIN
i, j: 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 {flash ← TRUE; RETURN};
[firstML, lastML] ← SelectMeasures[begin, end];
Voice.Correct[score[firstML].time, score[lastML].time];
[firstML, lastML] ← SelectMeasures[begin, end]; -- may have changed
IF firstML = lastML THEN lastML ← scoreLength-1;
key ← Score.GetKey[score[firstML].time];
lineBegin ← sheet[Sheet.FindLine[score[firstML].time+1]].time-1;
ShowLogical[firstML, lastML];
unjustifiedTime ← score[firstML].time;
i ← ML1 ← ML2 ← firstML;
DO i ← i+1; IF i > lastML THEN EXIT; -- FOR i 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 IN [i..scoreLength) DO
   IF (score[j].type = notes OR Measure[score[j].type]) 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 ~Sync.Hidden[ML1, j, unjustifiedTime] THEN EXIT;
    key ← score[j].value;
    delta ← ABS[key*8]; LOOP};
    -- score[j].time ← unjustifiedTime+5; so it won't get drawn
   ENDLOOP;
  lineEnd ← lineBegin+staffLength-MAX[ABS[key*8], 8]}; -- end initialization
 IF score[i].type = keySignature THEN key ← score[i].value;
 IF NOT Measure[score[i].type] 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 IN [ML1..scoreLength) 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+staffLength - 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 = scoreLength-1 AND score[ML2].type # staves THEN {s ← MIN[s, 2]; shorten ← TRUE};
 IF s > 10 THEN s ← 1; -- for empty lines
 FOR j 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 IN (lastML..scoreLength) DO
 score[i].time ← score[i].time+delta;
 ENDLOOP;
-- set up selection
Sheet.Reset[];
Selection.AddLine[score[firstML].time+1, score[lastML].time-1];
END;

SelectMeasures: PROC[t1, t2: Time] RETURNS[s1, s2: CARDINAL] =
BEGIN
m: CARDINAL;
delta: Time ← 10000;
s1 ← s2 ← 0;
m ← Piece.NearestSync[score, t1];
FOR i: CARDINAL DECREASING IN [0..m] DO
 IF NOT Measure[score[i].type] 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..scoreLength) DO
 IF NOT Measure[score[i].type] 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.NearestSync[score, t2];
FOR i: CARDINAL DECREASING IN [0..m] DO
 IF NOT Measure[score[i].type] 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..scoreLength) DO
 IF NOT Measure[score[i].type] 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[firstSync, lastSync: CARDINAL] =
BEGIN
staves: Staves;
ss: Voice.State;
prior: CARDINAL;
delta, endTime, break: Time;
lastTime ← 0;
Voice.ClearState[@ss];
vs ← ALL[0]; ps ← ALL[0];
IF show.display = physical THEN TF ← 3;
IF TF > 30 THEN TF ← 3;
show.display ← graphical;
IF firstSync = 0 THEN score[0].time ← 0;
endTime ← score[lastSync].time;
break ← score[firstSync].time;
[] ← Voice.SetState[@ss, score[firstSync]];
-- set up sheet
staves ← sheet[Sheet.FindSection[score[firstSync].time]].staves^;
sheet[0].time ← 0;
FOR i: CARDINAL IN [1..sheetLength) DO
 sheet[i].time ← 1000000;
 ENDLOOP;
-- layout the selected section
prior ← firstSync;
SetBackState[@ps, score[firstSync]];
FOR i: CARDINAL IN (firstSync..lastSync] DO
 Sync.Adjust[score[i]];
 score[i].time ← score[prior].time+1;
 IF (score[i].type = clef AND Sync.Hidden[0, i, break])
  THEN score[i].time ← score[prior].time+1
  ELSE {
   score[i].time ← Distance[score[prior], score[i], @ss];
   prior ← i; SetBackState[@ps, score[i]]};
 IF score[i].type = staves THEN break ← score[i].time;
 IF score[i].type = keySignature THEN sheet[0].key ← score[i].value;
 IF score[i].type NOT IN SheetSwitch THEN LOOP;
 Sync.SetStave[@staves, score[i]];
 staves ← LOOPHOLE[score[i].event];
 sheet[0].staves ← @staves;
 ENDLOOP;
-- move the rest of the score to the right
delta ← score[lastSync].time - endTime;
FOR i: CARDINAL IN (lastSync..scoreLength) DO
 score[i].time ← score[i].time + delta;
 ENDLOOP;
IF test THEN FOR i: CARDINAL IN [1..scoreLength) DO
 IF score[i].time < score[i-1].time THEN Error;
 ENDLOOP;
END;

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

Distance: PROCEDURE[a, b: SyncPTR, 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 Sync.Grace[b] THEN max ← max+10; -- move to the following note's max
FOR j IN [0..maxVoice] 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 # notes OR b.type # notes 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 IN [0..maxVoice] 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 = notes OR (a.type = notes AND Measure[b.type]) THEN
SELECT TRUE FROM
 Sync.Grace[a] => time ← start+6+TF/2;
 toc > 12000 => time ← start+10+20*TF;
 toc > 6000 => time ← start+8+12*TF;
 toc > 3000 => time ← start+8+8*TF;
 toc > 1500 => time ← start+8+4*TF;
 toc > 750 => time ← start+8+2*TF;
 ENDCASE => time ← start+8+TF;
lastTime ← max;
-- interaction with graphical objects
IF a.type = clef AND b.type = clef THEN RETURN[a.time];
FOR i IN [0..syncLength) DO
IF (n ← b.event[i]) = NIL THEN EXIT;
height ← Index[Sheet.Height[time+1, n.pitch, n.staff]];
IF NOT show.accidental THEN d ← 2
ELSE SELECT (acc ← Score.GetAccidental[n]) FROM
 inKey => d ← 2;
 doubleFlat => d ← 17;
 ENDCASE => d ← 12;
IF show.display = graphical THEN d ← d- Note.Delta[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 show.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[n]+5;
 FOR i: CARDINAL IN [Index[sheet[0].staves.staff[n.staff].y+40]..height] DO
  time ← MAX[time, ps[i]+d];
  ENDLOOP;
 FOR i: CARDINAL IN [height..Index[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 IN (height..MIN[height+9, off]) DO
   time ← MAX[time, ps[j]-8]; ENDLOOP
 ELSE FOR j IN [MAX[height, 8]-8..height) DO
   time ← MAX[time, ps[j]]; ENDLOOP;
ENDLOOP;
SELECT b.type FROM
IN [measure..m5], staves => BEGIN
  FOR i IN [0..off) DO time ← MAX[time, ps[i]]; ENDLOOP;
  FOR i IN [0..maxVoice] DO time ← MAX[time, vs[i]+4]; ENDLOOP;
  IF a.type = notes THEN time ← time+ measure[b.type]
    ELSE time ← time+3;
  END;
notes => NULL;
clef, octava1, octava2 => BEGIN
  FOR i IN [0..off) DO time ← MAX[time, ps[i]]; ENDLOOP;
  time ← time+3;
  END;
ENDCASE => BEGIN
  FOR i IN [0..off) DO time ← MAX[time, ps[i]]; ENDLOOP;
  END;
IF Measure[a.type] AND Measure[b.type] THEN time ← a.time+100;
IF a.type IN EventType[repeat1..m5] AND b.type = staves THEN RETURN[a.time];
RETURN[MAX[time, a.time+4]];
END;

SetBackState: PROCEDURE[ps: POINTER TO OffsetState, s: SyncPTR] =
BEGIN
n: NotePTR;
width: Time ← 0;
here: Time ← s.time;
i, j, offset: CARDINAL;
top, bottom: CARDINAL;
key: INTEGER ← Score.GetKey[s.time];
-- handle note events
FOR i IN [0..syncLength) DO
 IF (n ← s.event[i]) = NIL THEN EXIT;
 IF show.display = graphical THEN here ← Note.Delta[n]+s.time;
 offset ← Index[Sheet.Height[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[sheet[0].staves.staff[n.staff].y+40]..offset] DO
  ps[i] ← MAX[ps[i], here+width];
  ENDLOOP;
 FOR i: CARDINAL IN [offset..Index[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 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 IN [MAX[offset, 7]-7..offset) DO
   ps[j] ← MAX[ps[j], here+width];
   ENDLOOP};
ENDLOOP;
IF s.type = notes THEN RETURN;
-- handle all non-note events
top ← Index[0];
bottom ← Index[Sheet.Height[s.time, , 3]];
SELECT s.type FROM
timeSignature => width ← 14;
keySignature => width ← 8*ABS[key];
staves, IN [measure..m5] => width ← measure[measure];
metrenome => RETURN; -- {top ← bottom ← Index[Sheet.Height[s.time, , 0]+44]; width ← 20};
clef => {bottom ← Index[Sheet.Height[s.time, , s.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
i, v: CARDINAL;
d: INTEGER;
FOR i IN [0..syncLength) DO
IF s.event[i] = NIL THEN EXIT;
v ← s.event[i].voice;
d ← value[s.event[i].value]+(IF s.event[i].value = whole THEN 10 ELSE 8);
IF s.event[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 EventType[measure..staves] OF CARDINAL ← [6, 12, 12, 12, 8, 0, 0, 0, 0, 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.
(0, 3810)(1, 4445)(2, 5080)\616b2B24b13B966b17B676i54I166i24I262i30I745i26I81b7B4190b11B1813i32I980i35I2650i18I1287i26I