<> <> <> <> <> DIRECTORY InlineDefs 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]; SpacingImpl: CEDAR PROGRAM IMPORTS InlineDefs, MusicDefs, Note, Piece, Real, Score, Selection, Sheet, Sync, Voice EXPORTS Score = BEGIN OPEN MusicDefs; Error: SIGNAL = CODE; ts: PUBLIC TimeSignature; ScalePhysical: PUBLIC PROC[n: INTEGER] = { 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].timeend 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> 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 { 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; }; 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; }; Duration: PROC[n: NotePTR, metrenome: INTEGER] RETURNS[INTEGER] = { 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[InlineDefs.LowHalf[7*(d/8)]]; }; <<****************************************************************************>> <> <<****************************************************************************>> Justify: PUBLIC PROC[begin, end: Time] = { i, j: CARDINAL; one, s: REAL _ 1; key: INTEGER _ 0; shorten: BOOL _ 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}; <> 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 {ML2 _ i; LOOP}; score[i].time-unjustifiedTime=lineEnd-lineBegin => ML2 _ i; ENDCASE ; <> 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}; <> 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; <> delta _ score[lastML].time-unjustifiedTime; FOR i IN (lastML..scoreLength) DO score[i].time _ score[i].time+delta; ENDLOOP; <> Sheet.Reset[]; Selection.AddLine[score[firstML].time+1, score[lastML].time-1]; }; SelectMeasures: PROC[t1, t2: Time] RETURNS[s1, s2: CARDINAL] = { 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=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 }; ShowLogical: PUBLIC PROC[firstSync, lastSync: CARDINAL] = { 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]]; <> staves _ sheet[Sheet.FindSection[score[firstSync].time]].staves^; sheet[0].time _ 0; FOR i: CARDINAL IN [1..sheetLength) DO sheet[i].time _ 1000000; ENDLOOP; <> 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; <> 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; }; lastTime: Time; vs: VoiceOffset; ps: OffsetState; Distance: PROC[a, b: SyncPTR, ss: Voice.StatePTR] RETURNS[Time] = { n: NotePTR; d: INTEGER; acc: Accidental; related: BOOL _ FALSE; oldss: Voice.State _ ss^; time, toc, max, start: Time _ 0; i, j, height, up, down: CARDINAL _ 0; <> 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 { mod: Time _ toc MOD 256; IF mod<0 THEN mod _ mod+256; IF mod<2 OR mod>254 THEN related _ TRUE; }; 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; <> 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 ~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; <> 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; <> 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; <> 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 => { 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; }; notes => NULL; clef, octava1, octava2 => { FOR i IN [0..off) DO time _ MAX[time, ps[i]]; ENDLOOP; time _ time+3; }; ENDCASE => { FOR i IN [0..off) DO time _ MAX[time, ps[i]]; ENDLOOP; }; 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]]; }; SetBackState: PROC[ps: POINTER TO OffsetState, s: SyncPTR] = { n: NotePTR; width: Time _ 0; here: Time _ s.time; i, j, offset: CARDINAL; top, bottom: CARDINAL; key: INTEGER _ Score.GetKey[s.time]; <> 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]]; <> 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; <> 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; <> 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; <> 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; }; SetVoiceOffset: PROC[vs: POINTER TO VoiceOffset, s: SyncPTR] = { 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; }; 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: PROC[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: BOOL _ FALSE; END.