<> <> <> <> <> <<>> DIRECTORY Beam USING [AddItem, RemoveItem, SetSyncs], Chord USING [default, Free, GetHeapIndex, InVoice, RemoveNote, Sort], Event USING [AddNote], MusicDefs, Note USING [DrawHead, Width], Sheet USING [Map, MapNote], Utility USING [DrawBox, DrawChar, DrawLine, SetColor, SetCP]; ChordImpl: CEDAR PROGRAM IMPORTS Beam, Chord, Note, Sheet, Event, Utility EXPORTS Chord = BEGIN OPEN Chord, MusicDefs, Utility; SetBeam: PUBLIC PROC[c: ChordPTR, b: BeamPTR] = { FOR i: CARDINAL IN [0..c.length) DO c.note[i].beam _ b; ENDLOOP; }; GetHeapIndex: PUBLIC PROC[heap: ChordHeapPTR, c: ChordPTR] RETURNS[CARDINAL] = { FOR i: CARDINAL IN [0..heap.length) DO IF heap.chord[i] = c THEN RETURN[i]; ENDLOOP; RETURN[heap.length]; }; Grace: PUBLIC PROC[c: ChordPTR] RETURNS[BOOLEAN] = { FOR i: CARDINAL IN [0..c.length) DO IF ~c.note[i].grace THEN RETURN[FALSE]; ENDLOOP; RETURN[TRUE]; }; InVoice: PUBLIC PROC[c: ChordPTR, voice: CARDINAL] RETURNS[BOOLEAN] = { IF voice = noVoice THEN RETURN[TRUE]; FOR i: CARDINAL IN [0..c.length) DO IF c.note[i].voice = voice THEN RETURN[TRUE]; ENDLOOP; RETURN[FALSE]; }; <<****************************************************************************>> <> <> <> <<****************************************************************************>> AddNote: PUBLIC PROC[score: ScorePTR, chord: ChordPTR, note: NotePTR] = { chordSync: SyncPTR _ IF chord.note[0] # NIL THEN chord.note[0].sync ELSE note.sync; chordBeam: BeamPTR _ IF chord.note[0] # NIL THEN chord.note[0].beam ELSE NIL; IF chord = note.chord THEN RETURN; IF note.chord # NIL THEN Chord.RemoveNote[score, note.chord, note]; -- sets note.beam to NIL <> <> chord.note[chord.length] _ note; chord.length _ chord.length + 1; note.chord _ chord; IF chordSync # NIL AND chordSync # note.sync THEN { Event.AddNote[score, chordSync, note]; IF note.beam # NIL THEN Beam.SetSyncs[note.beam]}; IF chordBeam # NIL THEN { -- move note to this beam IF note.beam # NIL THEN Beam.RemoveItem[score, note.beam, note]; note.beam _ chordBeam}; IF chordBeam = NIL AND note.beam # NIL THEN { -- replace note with chord beam: BeamPTR _ note.beam; Beam.RemoveItem[score, beam, note, FALSE]; -- don't free beam! Beam.AddItem[score, beam, chord]}; }; RemoveNote: PUBLIC PROC[score: ScorePTR, chord: ChordPTR, note: NotePTR, free: BOOL] = { IF note = NIL OR chord = NIL THEN RETURN; <> FOR i: CARDINAL IN [0..chord.length) DO IF chord.note[i] # note THEN LOOP; IF note.chord = chord THEN note.chord _ NIL; IF chord.length = 1 AND note.beam # NIL THEN Beam.RemoveItem[score, note.beam, chord]; -- remove chord from beam note.beam _ NIL; -- removing a note from a chord also removes it from the beam chord.length _ chord.length - 1; chord.note[i] _ chord.note[chord.length]; chord.note[chord.length] _ NIL; EXIT; ENDLOOP; IF free AND chord.length < 2 THEN Chord.Free[score, chord]; }; New: PUBLIC PROC[score: ScorePTR, length: CARDINAL] RETURNS[chord: ChordPTR] = { chord _ NEW[ChordRec[length]]; <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> score.chordHeap.chord[score.chordHeap.length] _ chord; score.chordHeap.length _ score.chordHeap.length + 1; }; Free: PUBLIC PROC[score: ScorePTR, chord: ChordPTR] = { SetBackPointers[score, chord, NIL]; <> }; SetBackPointers: PROC[score: ScorePTR, c: ChordPTR, new: ChordPTR] = { <> <> chordBeam: BeamPTR _ IF c.length > 0 THEN c[0].beam ELSE NIL; index: CARDINAL _ Chord.GetHeapIndex[score.chordHeap, c]; score.chordHeap[index] _ new; IF new = NIL THEN { -- pack the beamHeap score.chordHeap.length _ score.chordHeap.length - 1; score.chordHeap[index] _ score.chordHeap[score.chordHeap.length]}; IF chordBeam # NIL AND new # NIL THEN { Beam.RemoveItem[score, chordBeam, c, FALSE]; -- don't free beam! Beam.AddItem[score, chordBeam, new]}; IF chordBeam # NIL AND new = NIL THEN { Beam.RemoveItem[score, chordBeam, c, c.length = 0]; -- don't free beam if length > 0 IF c.length > 0 THEN Beam.AddItem[score, chordBeam, c[0]]}; FOR i: CARDINAL IN [0..c.length) DO -- NIL chord back pointers in notes IF c.note[i].chord = c THEN c.note[i].chord _ new; ENDLOOP; }; Sort: PUBLIC PROC[c: ChordPTR, up: BOOL] RETURNS[note: CARDINAL] = { temp: NotePTR; FOR i: CARDINAL IN [0..c.length) DO FOR j: CARDINAL IN (i..c.length) DO IF NOT up AND c.note[i].pitch < c.note[j].pitch OR up AND c.note[i].pitch > c.note[j].pitch THEN { temp _ c.note[i]; c.note[i] _ c.note[j]; c.note[j] _ temp; }; ENDLOOP; ENDLOOP; }; SetDefaultStem: PUBLIC PROC[sheet: SheetPTR, c: ChordPTR] = { n: CARDINAL; x0, xn, y0, yn, middle0, middlen: INTEGER; n _ Chord.Sort[c, TRUE]; [x0, y0] _ Sheet.Map[sheet, c.note[0].sync.time, c.note[0].pitch, c.note[0].staff]; [xn, yn] _ Sheet.Map[sheet, c.note[n-1].sync.time, c.note[n-1].pitch, c.note[n-1].staff]; middle0 _ Sheet.Map[sheet, c.note[0].sync.time, , c.note[0].staff].y+16; middlen _ Sheet.Map[sheet, c.note[n-1].sync.time, , c.note[n-1].staff].y+16; SELECT TRUE FROM (yn+y0)/2 > middlen => c.stemUp _ FALSE; (yn+y0)/2 < middle0 => c.stemUp _ TRUE; (yn+y0)/2 > (middlen+middle0)/2 => c.stemUp _ TRUE; ENDCASE => c.stemUp _ FALSE; }; <<******************************************************************>> <> <<******************************************************************>> Draw: PUBLIC PROC[score: ScorePTR, c: ChordPTR, stem: INTEGER] = { w: REAL = 0; n: NotePTR; flag: NoteValue; two: REAL = 2; dotX: INTEGER _ 0; inVoice: BOOL; <> sheet: SheetPTR = score.sheet; nonGrace: BOOL _ FALSE; minStaff, maxStaff: CARDINAL; x, y, yMin, yMax, mid, width: INTEGER; inVoice _ score.sheet.voice = noVoice OR Chord.InVoice[c, score.sheet.voice]; -- draw the note heads FOR i: CARDINAL IN [0..c.length) DO n _ c.note[i]; IF ~n.dotted THEN LOOP; [x, y] _ Sheet.MapNote[sheet, n]; dotX _ MAX[dotX, x+Note.Width[n]+2]; ENDLOOP; mid _ Sheet.Map[sheet, n.sync.time, , n.staff].y+16; FOR i: CARDINAL IN [0..c.length) DO n _ c.note[i]; [x, y] _ Sheet.MapNote[sheet, n]; Note.DrawHead[score, n, x, y, dotX]; IF i = 0 THEN {yMin _ yMax _ y; width _ 0}; width _ MAX[width, Note.Width[n]]; <> <> < mid THEN MIN[yWide, y] ELSE MAX[yWide, y]}; >> IF ~n.grace THEN nonGrace _ TRUE; IF y <= yMin THEN {yMin _ y; minStaff _ n.staff}; IF y >= yMax THEN {yMax _ y; maxStaff _ n.staff}; ENDLOOP; IF NOT sheet.notehead THEN RETURN; <> Utility.SetColor[sheet.context, IF inVoice THEN black ELSE light]; IF sheet.display = graphical THEN x _ x - n.delta; -- subtract off x offset before drawing stem FOR i: INTEGER IN [3..9] WHILE yMax-mid >= i*d DO IF nonGrace THEN Utility.DrawBox[sheet.context, [x-3, mid+w+i*d, x+width+3, mid-w+i*d]] ELSE Utility.DrawBox[sheet.context, [x-3, mid+w/two+i*d, x+width+3, mid-w/two+i*d]]; ENDLOOP; FOR i: INTEGER IN [3..9] WHILE mid-yMin >= i*d DO IF nonGrace THEN Utility.DrawBox[sheet.context, [x-3, mid+w-i*d, x+width+3, mid-w-i*d]] ELSE Utility.DrawBox[sheet.context, [x-3, mid+w/two-i*d, x+width+3, mid-w/two-i*d]]; ENDLOOP; IF n.value = whole OR n.value = unknown THEN RETURN; <> flag _ n.value; IF stem # default -- drawing part of or beam THEN {stem _ (IF c.stemUp THEN stem+1 ELSE stem-1); flag _ quarter} ELSE SELECT TRUE FROM nonGrace AND c.stemUp => stem _ MAX[yMax+(7*d)/2, mid]; nonGrace AND ~c.stemUp => stem _ MIN[yMin-(7*d)/2, mid]; c.stemUp => stem _ yMax+2*d; ~c.stemUp => stem _ yMin-2*d; ENDCASE; IF c.stemUp THEN DrawLine[sheet.context, x+width, yMin, x+width, stem] ELSE DrawLine[sheet.context, x, yMax, x, stem]; <> IF nonGrace THEN Utility.SetCP[sheet.context, x, IF c.stemUp THEN stem-24 ELSE stem+24] ELSE Utility.SetCP[sheet.context, x, IF c.stemUp THEN stem-17 ELSE stem+17]; SELECT TRUE FROM ~nonGrace => IF c.stemUp THEN DrawChar[sheet.context, 133C] ELSE DrawChar[sheet.context, 134C]; flag = eighth => IF c.stemUp THEN DrawChar[sheet.context, 153C] ELSE DrawChar[sheet.context, 163C]; flag = sixteenth => IF c.stemUp THEN DrawChar[sheet.context, 152C] ELSE DrawChar[sheet.context, 162C]; flag = thirtysecond => IF c.stemUp THEN DrawChar[sheet.context, 151C] ELSE DrawChar[sheet.context, 161C]; flag = sixtyfourth => IF c.stemUp THEN DrawChar[sheet.context, 151C] ELSE DrawChar[sheet.context, 161C]; ENDCASE; }; d: CARDINAL = 8; <<****************************************************************************>> <> <<****************************************************************************>> Adjust: PUBLIC PROC[sheet: SheetPTR, c: ChordPTR] = { n: NotePTR; pad: REF ScratchPad ~ NEW[ScratchPad]; delta: INTEGER; last: BOOL _ FALSE; <> FOR i: NAT IN [0..c.length) DO [, pad[i].y] _ Sheet.MapNote[sheet, n]; pad[i].n _ n; n.delta _ 0; ENDLOOP; SortPad[c.stemUp, pad]; c.delta _ 0; <> IF c.stemUp THEN delta _ 8 ELSE delta _ -8; FOR i: NAT IN [1..c.length) DO IF last THEN { last _ FALSE; LOOP; }; IF ABS[pad[i-1].y-pad[i].y] >= 8 THEN LOOP; pad[i].n.delta _ delta; last _ TRUE; ENDLOOP; }; SortPad: PROC[ascending: BOOL, pad: REF ScratchPad] = { temp: Scratch; FOR i: NAT IN [0..padLength) DO IF pad[i].n = NIL THEN EXIT; FOR j: NAT IN (i..padLength) DO IF pad[j].n = NIL THEN EXIT; IF NOT ascending AND pad[i].y < pad[j].y OR ascending AND pad[i].y > pad[j].y THEN { temp _ pad[i]; pad[i] _ pad[j]; pad[j] _ temp; }; ENDLOOP; ENDLOOP; }; Delta: PROC[n: NotePTR] RETURNS[INTEGER] = { c: ChordPTR ~ n.chord; IF c = NIL THEN RETURN[n.delta] ELSE RETURN[n.delta+c.delta]; }; padLength: NAT = 16; ScratchPad: TYPE = ARRAY [0..padLength) OF Scratch; -- need to make this variable length Scratch: TYPE = RECORD[ x, y, stem: INTEGER _ 0, push: NAT _ padLength, acc: Accidental, stemUp: BOOL, c: ChordPTR, n: NotePTR _ NIL ]; END.