diff options
Diffstat (limited to 'Build/source/utils/xml2pmx/xml2pmx-src/obsrc/b.m')
-rw-r--r-- | Build/source/utils/xml2pmx/xml2pmx-src/obsrc/b.m | 1141 |
1 files changed, 0 insertions, 1141 deletions
diff --git a/Build/source/utils/xml2pmx/xml2pmx-src/obsrc/b.m b/Build/source/utils/xml2pmx/xml2pmx-src/obsrc/b.m deleted file mode 100644 index 142da41b440..00000000000 --- a/Build/source/utils/xml2pmx/xml2pmx-src/obsrc/b.m +++ /dev/null @@ -1,1141 +0,0 @@ -MODULE b; -(* Achtung "PrintRange" eingebaut, zusaetzliche Importe *) - -(***************************************************************************) -(**************** Copyright 2015--2021 Dieter Gloetzel ********************) -(************************ Version016 multi platform ***********************) -(***************************************************************************) -(* This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see <http://www.gnu.org/licenses/>. *) - -IMPORT Files := MyFiles, Strings := Strings1, Fifo, Out; -TYPE LONGINT = INTEGER; -CONST CR= 0DX; NL = 0AX; BLANK = 20X; DBLQUOTE = 22X; TAB=09X; -TYPE - Tag* = POINTER TO TagDesc; (* List structure for data acquisition *) - TagDesc* = RECORD - nr*: LONGINT; (* counter of tags *) - chord*: CHAR; cue* : BOOLEAN; - arpeggio*: BOOLEAN; - part*, staff*, voice*, voice12*, measure*, dirnum*, lastnote*, nextnote*, nextvoice*, attnum*, note*, novalues*: LONGINT; - (* to be used as indices of ARRAY "notes" *) - tagname*: ARRAY 32 OF CHAR; - endtag*: ARRAY 32 OF CHAR; - next*: Tag; - names*: ARRAY 10 OF ARRAY 32 OF CHAR; - values*: ARRAY 10 OF ARRAY 32 OF CHAR; - between*: ARRAY 64 OF CHAR; - used*: BOOLEAN; - duration*, backup*, voicetime*, from*, to*: INTEGER; - probj*: CHAR; (* when "n" the complete object has to be removed *) - grace*: INTEGER; (* counts consecutive grace notes *) - newclef* : CHAR; (* only for notes or rests. the new clef is applied to this note. *) - END; - FIFO* = RECORD - first*, last*: Tag; - END; - Node = POINTER TO NodeDesc; - NodeDesc = RECORD - key: ARRAY 64 OF CHAR; - count: INTEGER; - n : Tag; - next: Node; - END; - - -VAR q* : FIFO; voutput* : BOOLEAN; nostaves* : LONGINT; unix* : BOOLEAN; -sout : ARRAY 64 OF CHAR; (* target file path and directory *) -tieunusdnum*: ARRAY 27 OF ARRAY 3 OF SET; -tieq: ARRAY 27 OF ARRAY 2 OF Fifo.FIFO; - - akeys*, mkeys* : ARRAY 27 OF INTEGER; - nstr : ARRAY 8 OF LONGINT; (* global for number of verses in a liedtext.*) - text: ARRAY 8 OF ARRAY 6 OF ARRAY 1024 OF CHAR; (* texts for at most 6 verses and 8 voices choir; length limited to 1023 Chars *) -(* PROCEDURE PrintRange*; - VAR S : Texts.Scanner; von, bis, i : LONGINT; n : Tag; - BEGIN - Texts.OpenScanner (S, Oberon.Par.text, Oberon.Par.pos); - Texts.Scan(S); von := S.i; Texts.Scan(S); bis := S.i; - n:= q.first; - WHILE (n.next # NIL) & (i < von ) DO n := n.next; INC(i); END; - WHILE (n.next # NIL) & ( i < bis ) DO OutTag(n,TRUE); n := n.next; INC(i); END; -END PrintRange; *) - -PROCEDURE slur2PMX* ( n: Tag; VAR pmxslur: ARRAY OF CHAR ; outputset : SET); - (* Translates a beginning or ending slur from XML to PMX. *) - - VAR c, cs : CHAR; - type, number, placement: ARRAY 32 OF CHAR; inumber : LONGINT; - BEGIN - loesch( pmxslur ); FindAtt( n, "type", type ); FindAtt( n, "number", number ); - IF ( number # "" ) THEN - Strings.StrToInt(number, inumber); - cs := CHR(inumber + 65) - ELSE cs := "A"; - END; - FindAtt( n, "placement", placement ); - IF (type # "continue") THEN (* gibt es das ueberhapt? *) - - COPY( BLANK, pmxslur ); - IF (type = "start") THEN c := "("; - ELSIF (type = "stop") THEN c := ")" - ELSE c := "?" - END; - Strings.AppendCh( pmxslur, c ); - Strings.AppendCh( pmxslur, cs ); - (* Achtung x-option for staff crossing slur *) - IF 8 IN outputset THEN Strings.Append(pmxslur,"x"); END; - - IF (type = "start") THEN (* gibt es slurs ohne placement Angabe? *) - IF (placement = "below") THEN Strings.AppendCh( pmxslur, "l" ) - ELSIF (placement = "above") THEN Strings.AppendCh( pmxslur, "u" ); - END; - END; - Strings.AppendCh( pmxslur, BLANK ); c := 0X; Strings.AppendCh( pmxslur, c ); - - END; - (* Out.Ln(); Out.String( "slur2pmx : " ); Out.String( pmxslur ); *) - - (* Slur control according to grace property *) - - END slur2PMX; - PROCEDURE tied2PMX* ( n: Tag; type: ARRAY OF CHAR; VAR pmxtied: ARRAY OF CHAR; ps, voice: LONGINT); - (* Translates a beginning or ending tie from XML to PMX. - orientation = "d" => note with stem down yields tie with orientation "u". - orientation = "u" => note with stem up yields tie with orientation "l". *) - VAR c: CHAR; - number: ARRAY 4 OF CHAR; orient : ARRAY 10 OF CHAR; orientation : CHAR; - nt: Fifo.Node; - - BEGIN - loesch( pmxtied ); FindAtt( n, "number", number ); - FindAtt( n, "orientation", orient ); - IF orient = "over" THEN orientation := "u"; (* IF orient = "" THEN follow stem direction *) - ELSIF orient = "under" THEN orientation := "l"; - ELSE orientation := " "; - END; - - (* Out.Char("|"); Out.String("tied : "); Out.Char("|");Out.String(type);Out.Char("|"); - Out.String(number);Out.Char("|");Out.Char(orientation); *) - COPY( BLANK, pmxtied ); - IF (type = "start") THEN - c := "{"; - Strings.AppendCh( pmxtied, c ); - NEW( nt ); nt.key := Fifo.smallfree( tieunusdnum[ps, voice] ); - EXCL( tieunusdnum[ps, voice], nt.key ); - Fifo.Enqueue( tieq[ps, voice], nt ); - Strings.IntToStr( nt.key, number ); - Strings.Append( pmxtied, number ); - Strings.AppendCh( pmxtied, orientation ); - ELSIF (type = "stop") THEN c := "}"; Strings.AppendCh( pmxtied, c ); - - nt := Fifo.DequeuedNode( tieq[ps, voice] ); - IF nt # NIL THEN INCL( tieunusdnum[ps, voice], nt.key ); (* avoid nt undefined *) - Strings.IntToStr( nt.key, number ); Strings.Append( pmxtied, number ); END; - ELSE Out.String( "wrong type of tie " ); - END; - Strings.AppendCh( pmxtied, BLANK ); - END tied2PMX; - - - -PROCEDURE lyric*( ps: LONGINT; VAR n: Tag ); - VAR endtag: ARRAY 32 OF CHAR; - number, syllabic: ARRAY 10 OF CHAR; istr : LONGINT; - BEGIN - IF (n.tagname = "<lyric>") (* & (number = "1") *) THEN - - COPY( n.endtag, endtag ); FindAtt( n, "number", number ); - Strings.StrToInt (number,istr); - nstr[ps] := Max(istr,nstr[ps]); - - WHILE (n.tagname # endtag) DO - IF n.tagname = "<syllabic>" THEN COPY( n.between, syllabic ); END; - IF n.tagname = "<text>" THEN Strings.Append( text[ps,istr], n.between ); END; - n := n.next; - END; - IF (syllabic = "single") OR (syllabic = "end") THEN Strings.AppendCh( text[ps,istr], " " ); END; - IF (syllabic = "begin") OR (syllabic = "middle") THEN Strings.AppendCh( text[ps,istr], "-" ); END; - END; - END lyric; - PROCEDURE writetext*; - VAR i, j, istr, column: LONGINT; breakline: BOOLEAN; f: Files.File; r: Files.Rider; - s: ARRAY 4 OF CHAR; - BEGIN - Strings.Append(sout,"songtext.txt"); -Out.Ln(); Out.String("Storage for verses : "); Out.String(sout); - i := 0; f := Files.New( sout ); Files.Set( r, f, 0 ); - WHILE i < nostaves DO - istr := 1; - WHILE istr <= nstr[i] DO (*$$$$$$$$$$$$$*) - IF (Strings.Length( text[i,istr] ) > 0) THEN - - (* IF ~unix THEN Files.Write( r, CR ); END; *) - - Files.Write( r, NL ); Strings.IntToStr( i + 1, s ); - Files.WriteBytes( r, s, Strings.Length( s ) ); - Strings.IntToStr(istr,s); Files.Write(r,"|"); - Files.WriteBytes( r, s, Strings.Length( s ) ); - j := 0; column := 0; - WHILE j < Strings.Length( text[i,istr] ) DO - - REPEAT - IF (text[i,istr, j] # "_") THEN Files.Write( r, text[i,istr, j] ); END; - INC( j ); INC( column ); breakline := (column > 80) & (text[i,istr, j] = BLANK); - IF breakline THEN - IF ~unix THEN Files.Write( r, CR ); END; - Files.Write( r, NL ); breakline := FALSE; column := 0; - END; - - UNTIL (text[i,istr, j] = 0X) OR (text[i,istr, j] = BLANK); - IF text[i,istr, j] = BLANK THEN Files.Write( r, BLANK ); END; - - INC( j ); - END; - END; - - - INC(istr); - IF ~unix THEN Files.Write( r, CR ); END; - Files.Write( r, NL ); - END; - IF ~unix THEN Files.Write( r, CR ); END; Files.Write( r, NL ); - INC( i ) - END; - Files.Close( f ); Files.Register( f ); - END writetext; - - - - - - PROCEDURE SortTags*; - (* Command to list the different tags after calling the comman "Testbed.AalyzeXML" *) - VAR n: Tag; first, st: Node; - BEGIN - first := NIL; - n := q.first; - WHILE n # NIL DO NEW( st ); COPY( n.tagname, st.key ); InsertRanked( first, st ); n := n.next; END; - st := first; Out.Ln(); Out.String("==============================================="); - Out.Ln(); Out.String( " Sorted List of Tags " ); - WHILE (st # NIL ) DO - IF (st.key[1] # "/") THEN Out.Ln(); Out.String( st.key ); Out.Int( st.count, 5 ); END; - st := st.next - END; - - END SortTags; - - PROCEDURE InsertRanked( VAR first: Node; new: Node ); - (* Builds up a sorted list according to Node.key, counts the occurrences of the different keys *) - VAR n: Node; - BEGIN (* new # NIL *) - IF (first = NIL ) OR (new.key < first.key) THEN new.next := first; new.count := 1; first := new - ELSE - n := first; - WHILE (n.next # NIL ) & (new.key >= n.next.key) DO n := n.next END; - IF (n.key # new.key) & (new.key[0] # 0X) THEN (* store only distinct values *) - new.next := n.next; n.next := new; new.count := 1; - ELSE INC( n.count ) - END; - END - END InsertRanked; - - -(* PROCEDURE SortKey( q : FIFO ); - (* Sort notes according to Measure (ascending), Part(descending), Staff(descending) and Voice(descending). *) - VAR n : Tag; st : Node; - BEGIN - n := q.first; - WHILE n.next # NIL DO - IF ( n.tagname = "<notes>" ) THEN - NEW(st); - mpsvn2String(n.measure, n.part, n.staff, n.voice, n.note,st.key); - st.n := n; maxtag := Max(n.nr,maxtag); - InsertRanked (nfirst,st) - END; - n := n.next; - END; - END SortKey; *) - -(* PROCEDURE arplen*( n: Tag; VAR maxarp: LONGINT ); - (* When n is the first note of a sequence of arpeggionotes, then maxarpe is the number of arpeggio notes.*) - VAR m: Tag; - BEGIN - maxarp := 0; (* OutTag( n, TRUE ); *) - IF n.arpeggio = 1 THEN - REPEAT findnextnote( n, m ); maxarp := Max( maxarp, n.arpeggio ); n := m; UNTIL (m.arpeggio = 0) OR ( m = NIL ) - - END; - END arplen; *) - - PROCEDURE gracelen*( n: Tag; VAR maxgrace: LONGINT ); - (* When n is the first note of a sequence of gracenotes, then maxgrace is the number of grace notes.*) - (* n.grace numbers the grace notes in a concsecutive series *) - VAR m: Tag; - BEGIN - - maxgrace := 0; (* OutTag( n, TRUE ); *) - IF n.grace = 1 THEN - REPEAT findnextnote( n, m ); - IF ( n.chord # "c" ) THEN maxgrace := Max( maxgrace, n.grace ); END; - n := m; UNTIL m.grace = 0; - (* IF statement to remove chord notes from a series of grace notes; 11.2.2017 *) - - END; - END gracelen; - - PROCEDURE Outset*( s: SET; VAR count: LONGINT; VAR elemmap: ARRAY OF LONGINT ); - (* prints a set in System.Log and returns the # of elements and a vector of elements in ascending order. *) - VAR i, j: LONGINT; - BEGIN - IF voutput THEN Out.Char( "{" ); END; count := 0; i := 0; - REPEAT INC( i ) UNTIL (i = 31) OR (i IN s); - IF voutput THEN Out.Int( i, 2 ); END; - IF (i IN s) THEN elemmap[count] := SHORT( i ); INC( count ); END; - INC( i ); - WHILE i < 32 DO - IF i IN s THEN IF voutput THEN Out.Char( "," ); Out.Int( i, 2 ); END; elemmap[count] := SHORT( i ); INC( count ); END; - INC( i ); - END; - IF voutput THEN - Out.Char( "}" ); Out.Int( count, 5 ); Out.Char( "|" ); j := 0; - WHILE j < count DO Out.Int( elemmap[j], 5 ); INC( j ) END; - END; - END Outset; - - PROCEDURE findnextnote*( n: Tag; VAR m: Tag ); - (* finds the next note "m" after "n", *) - BEGIN - m := n; (* Korrektur 22.06.2019 *) - REPEAT m := m.next - UNTIL (m.next = NIL ) OR (m.tagname = "<note>"); - - (* Out.Ln(); Out.String( "findnextnote : " ); Out.Int(m.nr,5); Out.String( m.tagname ); *) - - - END findnextnote; - PROCEDURE findnextnotestaff*( n: Tag; VAR m: Tag; number : LONGINT); - (* finds the next note "m" after "n", *) - - BEGIN - m := n; (* Korrektur 22.06.2019 *) - REPEAT m := m.next; - UNTIL (m.next = NIL ) OR ( (m.tagname = "<note>") & ( m.staff = number ) ) ; - - (* Out.Ln(); Out.String( "findnextnote : " ); Out.Int(m.nr,5); Out.String( m.tagname ); *) - - - END findnextnotestaff; - - PROCEDURE compareTag*; - VAR n : Tag; - VAR i : LONGINT; - BEGIN - i := 0; - n := q.first; - WHILE i < 1000 DO - OutTag(n,TRUE); - n := n.next; - INC(i); - END; - - - - END compareTag; - - -PROCEDURE OutTag*( n: Tag; ln: BOOLEAN ); - (* Writes the properties of one tag into System.Log. *) - VAR i: LONGINT; - - BEGIN - IF (n # NIL ) (* & (n.part # 0) *) THEN - IF ln THEN Out.Ln(); END; - Out.Int( n.nr, 5 ); Out.String( " : " ); (* 1 *) - Out.Int( n.part, 5 ); Out.String( " : " ); (* 2 *) - Out.Int( n.staff, 5 ); (* 3 *) - Out.Int( n.voice , 5 ); (* 4 *) - (* Out.Char("|"); Out.Int( n.voice12 , 5 ); (* 4 *) *) - - Out.Int( n.measure, 5 ); (* 5 *) - Out.Int( n.note, 5 ); (* 6 *) - Out.Int( n.grace, 5 ); (* 7 *) - Out.Int( n.from, 5 ); Out.Int( n.to, 5 ); (* 8, 9 *) - IF n.chord # 0X THEN Out.Char( n.chord ); ELSE Out.Char("-") END; (* 10 *) - (* IF n.arpeggio THEN Out.String(" ? "); END; (* 11 *) *) - Out.Int( n.dirnum, 5 ); (* 11 *) - Out.Int( n.lastnote, 5 ); (* 12 *) - Out.Int( n.nextnote, 5 ); (* 13 *) - Out.Int( n.nextvoice, 5 ); (* 14 *) - Out.Int( n.attnum, 5 ); (* 15 *) - Out.Char(n.newclef); (* 17.10.2020 new implementation of clefs *) - (* Out.Int( n.arpeggio, 5 ); *) - Out.Char( n.probj ); (* 17 *) -(* IF n.cue THEN Out.String("cue"); END; *) - - (* Out.String("backup"); Out.Int(n.backup,5); *) - (* Out.String(" backup,duration,voicetime, from, to : ");Out.Int( n.backup, 5 ); - Out.Char("|"); Out.Int(n.duration,5); Out.Char("|");Out.Int(n.voicetime,5); - Out.Char("|");Out.Int(n.from,5);Out.Char("|");Out.Int(n.to,5); *) - Out.String( n.tagname ); (* Out.String( n.endtag ); *) - i := 0; - WHILE (i < n.novalues) DO - Out.String( n.names[i] ); Out.Char( "=" ); Out.String( n.values[i] ); Out.Char( "|" ); INC( i ) - END; - - Out.String( n.between ); - - IF n.used THEN Out.Char( "+" ); - END; - - ELSE Out.Ln(); Out.String( "Tag ist NIL. " ); - - END - END OutTag; - - - - PROCEDURE StoreTag*( itags: LONGINT; tag, endtag: ARRAY OF CHAR; part, voice, measure, note, attnum, dirnum, lastnote : LONGINT; - novalues: LONGINT; names, values: ARRAY OF ARRAY OF CHAR; between: ARRAY OF CHAR ); - (* Stores a decoded MusicXML tag as element of a linked list. *) - VAR new: Tag; k: LONGINT; - printobj: ARRAY 32 OF CHAR; - BEGIN - NEW( new ); new.nr := itags; COPY( tag, new.tagname ); COPY( endtag, new.endtag ); new.part := part; - new.voice := voice; new.used := FALSE; new.measure := 0; - (* Out.Ln(); Out.String("StoreTag : itags, tag, endtag, part, measure, note, lastnote "); -Out.Int(itags,5); Out.String(tag); Out.Int(part,5); Out.Int(measure,5); Out.Int(note,5); Out.Int(lastnote,5); Out.Char("|");Out.String(between); - - *) - - - IF (new.tagname # "<part>") THEN - new.measure := measure; - IF (new.tagname # "<measure>") THEN - new.note := note; new.attnum := attnum; new.dirnum := dirnum; new.lastnote := lastnote; - END; - END; - k := 0; new.novalues := novalues; - WHILE (k < novalues) DO COPY( names[k], new.names[k] ); COPY( values[k], new.values[k] ); INC( k ); - - END; - FindAtt( new, "print-object", printobj ); - IF (new.tagname = "<note>") & (printobj = "no") THEN new.probj := "n" ELSE new.probj := BLANK; END; - (* COPY( between, new.between ); *) ; k := 0; - WHILE k < 64 DO new.between[k] := between[k]; INC( k ); END; - new.between[k - 1] := 0X; - (* Out.Ln();Out.String("**********************OutTag************************************"); Out.Ln(); - *) - (* OutTag( new ); *) - Enqueue( q, new ); - END StoreTag; - PROCEDURE Enqueue( VAR q: FIFO; n: Tag ); - (* puts Tag "n" into the list "q" *) - BEGIN - n.next := NIL; - IF q.first # NIL THEN q.last.next := n ELSE q.first := n END; - q.last := n - END Enqueue; - - - PROCEDURE FindAtt*( n: Tag; name: ARRAY OF CHAR; VAR value: ARRAY OF CHAR ); - (* Properties of a tag are stored as name-value pairs. The procedure finds the value of an attribute by its name. *) - VAR i: LONGINT; - BEGIN - i := 0; - WHILE (i < n.novalues) & (n.names[i] # name) DO INC( i ) END; - IF (n.names[i] = name) THEN COPY( n.values[i], value ); - ELSE (* Out.Ln(); Out.String( " FindAtt : name not found " ); Out.String( name ); OutTag( n ); *) - END; - END FindAtt; -(* PROCEDURE FindNextNote* (VAR n : Tag); (* for removing cue notes ; finds next note after "n" or "n" when it is a note *) - VAR - BEGIN - IF n.tagname # "<note>" THEN - REPEAT n:= n.next UNTIL ( (n.tagname = "<note>" ) & ( n.grace = 0 ) ) OR ( n.next = NIL ) ; (* &&&&& *) - ELSE - END; - END FindNextNote; *) - -PROCEDURE PosInStaff*(pitchnote : CHAR;pitchoctave : INTEGER; clef : CHAR) : LONGINT; -(* calculates the position of the note "pitchnote/pitchoctave" in the staff according to clef. *) -VAR diff : LONGINT; -BEGIN - -CASE clef OF -"t" : diff := DiaDiff(pitchnote,pitchoctave,"g",4) + 2; -| "b" : diff := DiaDiff(pitchnote,pitchoctave,"f",3) + 6; -| "a" : diff := DiaDiff(pitchnote,pitchoctave,"c",4) + 4; -| "n" : diff := DiaDiff(pitchnote,pitchoctave,"c",4) + 6; -ELSE Out.Ln(); Out.String("PosinStaff: clef not implemented : "); Out.Char(clef); -END; RETURN diff; -END PosInStaff; -PROCEDURE DiaDiff(pitchnote : CHAR; pitchoctave : INTEGER; refnote : CHAR; refoctave : INTEGER) : LONGINT; -(* Calculates the diatonic difference between to notes in PMX notation. *) -VAR -diffnote, diffoctave : LONGINT; -BEGIN - -diffoctave := pitchoctave - refoctave; -diffnote := ORD(pitchnote) - ORD(refnote); -RETURN diffnote + diffoctave * 7; -END DiaDiff; - -PROCEDURE MinDist*(x : INTEGER; pos : ARRAY OF INTEGER; posmax : INTEGER) : INTEGER; -(* finds the index of "pos" with minimum difference to "x". *) -VAR i, imin, delta : INTEGER; - -BEGIN -delta := ABS(x-pos[0]); imin := 0; -i := 1; -WHILE i < posmax DO - IF ABS(x-pos[i]) < delta - THEN imin := i; delta := ABS(x-pos[i]); END; - INC(i) - END; -RETURN imin; -END -MinDist; -PROCEDURE testMinDist*; -VAR pos : ARRAY 5 OF INTEGER; - -BEGIN -pos[0] := 57; -pos[1] := 163; -pos[2] := 273; -pos[3] := 381; -Out.Ln(); Out.String("MinDIst test "); Out.Int (MinDist(279,pos,4),5); - - -END testMinDist; - -PROCEDURE pmxTremolo* (pitchnote : CHAR; pitchoctave : INTEGER; stem, clef : CHAR; nobeams : LONGINT; pmxdur0 : CHAR; VAR res : ARRAY OF CHAR); - VAR i,pos : LONGINT; offset : ARRAY 4 OF CHAR; - BEGIN - - pos := PosInStaff(pitchnote,pitchoctave,clef); - Strings.IntToStr(pos,offset); - IF stem ="d" THEN stem:= "l"; END; - IF stem = 0X THEN stem := "l" END; - IF (pmxdur0 = "0") - THEN - IF (pos > 4) THEN - stem := "l" ELSE stem := "u"; END; - END; - res[0] := "\"; - CASE pmxdur0 OF - "0" : Strings.AppendCh(res,"T"); - | "2","4" : Strings.AppendCh(res,"t"); - ELSE - Out.String(" pmxTremolo ; unknown pmx duration : "); Out.Char(pmxdur0); - END; - i := 0; WHILE i < nobeams DO Strings.AppendCh(res,"r"); INC(i) END; - Strings.AppendCh(res,"m"); - Strings.AppendCh(res,stem); - Strings.AppendCh(res,"{"); - Strings.Append(res,offset); Strings.Append(res,"}\ "); - - END pmxTremolo; - - -PROCEDURE ReadStringUntil*(VAR W : Files.Rider; split : CHAR; VAR s : ARRAY OF CHAR); -(* Formatted read of STRING until "split" Character from file *) -VAR i : LONGINT; c : CHAR; -BEGIN -loesch(s); -i := 0; Files.Read(W,c); -REPEAT - s[i] := c; - INC(i); - Files.Read(W,c); - UNTIL c = split; -s[i] := 0X; -END ReadStringUntil; - - - PROCEDURE APPzca* (VAR s,t : ARRAY OF CHAR); - (* Appends a 2nd \zcharnote-element to the first one. *) - VAR i,j : LONGINT; - BEGIN - i := Strings.Length(s); -(* Out.Ln(); Out.String("vorher : ");Out.String(s); Out.Ln(); Out.String(t); *) - s[i-2] := BLANK; s[i-1] := 0X; - - j := 0; WHILE t[j] # "}" DO INC(j) END; - i := i-1; j := j+2; REPEAT s[i] := t[j]; INC(i); INC(j) UNTIL t[j] = 0X ; -(* Out.Ln(); Out.String("nachher : ");Out.String(s); *) - END APPzca; - - PROCEDURE IsSep(c : CHAR) : BOOLEAN; - -BEGIN -RETURN ( c = 20X ) OR ( c = 22X ) OR ( c = "," ) - -END IsSep; -PROCEDURE FindToken* (VAR s, t : ARRAY OF CHAR; VAR pos : LONGINT); -VAR j : LONGINT; -BEGIN -IF IsSep(s[pos] ) THEN REPEAT INC(pos) UNTIL (pos = Strings.Length(s)-1 ) OR ~IsSep(s[pos]); (* first CHAR # separator found *) -END; -j := 0; t[j] := s[pos]; - -WHILE (pos < Strings.Length(s) ) & ~IsSep (s[pos] ) DO -t[j] := s[pos]; - INC(pos); INC(j); END; - t[j] := 0X; - -END FindToken; - - - - PROCEDURE strbetween*( s: ARRAY OF CHAR; VAR name: ARRAY OF CHAR; VAR pos: LONGINT ); - VAR i, j: LONGINT; - BEGIN - i := pos; - WHILE (i < Strings.Length( s )) & (s[i] # DBLQUOTE) DO INC( i ) END; (* Find first doublequote *) - j := 0; INC( i ); - IF ( i = Strings.Length( s ) ) - THEN - pos := -1 - ELSE - WHILE (i < Strings.Length( s )) & (s[i] # DBLQUOTE) DO name[j] := s[i]; INC( i ); INC( j ) END; - pos := i + 1; name[j + 1] := 0X; - IF ( i = Strings.Length( s ) ) THEN pos := -1 END - - END; - END strbetween; - PROCEDURE Copywo*( VAR fin, fout: Files.File ); - (* Copies a File and eliminates multiple BLANKs. *) - VAR ch: CHAR; rin, rout: Files.Rider; column: LONGINT; - BEGIN - Files.Set( rin, fin, 0 ); Files.Set( rout, fout, 0 ); column := 0; Files.Read( rin, ch ); - WHILE ~rin.eof DO - Files.Write( rout, Strings.OberonToISO[ORD( ch )] ); INC( column ); - IF (ch = NL) THEN column := 0; END; - IF (column > 100) & (ch = BLANK) THEN column := 0; Files.Write( rout, CR ); Files.Write( rout, NL ); END; - - (* IF ch =Strings.CR THEN Files.Write(R,NL); END; *) - IF (ch = BLANK) THEN - WHILE (ch = BLANK) DO Files.Read( rin, ch ); END; - ELSE Files.Read( rin, ch ); - - END; ; - - END; - END Copywo; - - PROCEDURE close*( pattern: ARRAY OF CHAR; VAR closetag: ARRAY OF CHAR ); - (* creates the closing tag out of the start tag: e.g. </note> out of <note> *) - VAR i: INTEGER; - BEGIN - closetag[0] := "<"; closetag[1] := "/"; i := 1; - WHILE i < Strings.Length( pattern ) DO closetag[i + 1] := pattern[i]; INC( i ); END; - closetag[i + 1] := 0X; - END close; -PROCEDURE clefPMX*( clefsign: CHAR; clefline: INTEGER; VAR c, otherclef : CHAR); - - BEGIN - c := "t"; (* default: violin clef *) - - (* Out.Ln(); Out.String(" clefsign, clefline, otherclef, pmxsymbol : ");Out.Char(clefsign); Out.Int(clefline,5); Out.Char(otherclef); *) - CASE clefsign OF - "C": IF (clefline = 3) THEN c := "a" - ELSIF (clefline = 4) THEN c := "n" - ELSIF (clefline = 2) THEN c := "m" - ELSIF (clefline = 1) THEN c := "s" - ELSE Out.Ln(); Out.String( "Clef not implemented." ); - END; - - | "F": - IF (clefline = 3) THEN c := "r" - ELSIF (clefline = 4) THEN c := "b" - ELSE Out.Ln(); Out.String( "Clef not implemented." ); - END; - - | "G": - IF (clefline = 2) THEN c := "t" - ELSIF (clefline = 1) THEN c := "f" - ELSE Out.Ln(); Out.String( "Clef not implemented." ); - END; - | "p": c := "t"; - otherclef := "p"; Out.Ln(); Out.Char("p"); - - ELSE Out.Ln(); Out.String( "unknown Clef symbol " ); - END; (* Out.Char(c); *) - END clefPMX; -PROCEDURE NewBeat*( beat, beattype: INTEGER; VAR res: ARRAY OF CHAR; blind : BOOLEAN ); - VAR sbeat, sbeattype: ARRAY 5 OF CHAR; - BEGIN - Strings.IntToStr( beat, sbeat ); Strings.IntToStr( beattype, sbeattype ); COPY( "m", res ); - Strings.Append( res, sbeat ); Strings.AppendCh( res, "/" ); Strings.Append( res, sbeattype ); - - Strings.AppendCh( res, "/" ); - IF ~blind THEN - Strings.Append( res, sbeat ); Strings.AppendCh( res, "/" ); - Strings.Append( res, sbeattype ); Strings.AppendCh( res, BLANK ); - ELSE - Strings.Append( res, "0" ); Strings.AppendCh( res, "/" ); - Strings.Append( res, "0" ); Strings.AppendCh( res, BLANK ); - END; - - - - END NewBeat; -PROCEDURE loeschint* ( VAR string: ARRAY OF LONGINT ); - (* resets an ARRAY OF LONGINT TO zero. *) - VAR i : INTEGER; - BEGIN - i := 0; - WHILE i < LEN( string ) DO string[i] := 0; INC( i ) END; - END loeschint; - - - PROCEDURE loesch*( VAR string: ARRAY OF CHAR ); - (* resets an ARRAY OF CHAR to "0X". *) - VAR i: INTEGER; - BEGIN - i := 0; - WHILE i < LEN( string ) DO string[i] := 0X; INC( i ) END; - END loesch; -PROCEDURE FindLetter*( s: ARRAY OF CHAR; VAR pos: LONGINT; VAR eor: BOOLEAN ); - (* Returns the position of the next letter in the string "s" starting at position "pos". - When no letter has been found *) - VAR i: LONGINT; - BEGIN - i := pos; - WHILE (s[i] # ">") & ~Strings.IsAlpha( s[i] ) DO INC( i ) END; - IF Strings.IsAlpha( s[i] ) THEN pos := i; ELSE eor := TRUE END; - END FindLetter; - - PROCEDURE ReadUntil*( s: ARRAY OF CHAR; VAR pos: LONGINT; stop: CHAR; VAR word: ARRAY OF CHAR; - VAR eor: BOOLEAN ); - (* Reads a word starting at Pposition "pos" and ending before "stop"-character. BLANKs are excluded *) - VAR i, j: LONGINT; - BEGIN - loesch( word ); i := pos; j := 0; - WHILE ( j < LEN(word)) & (s[i] # ">") & (s[i] # stop) DO (*correction 9.11.2016 *) - IF (s[i] # BLANK) THEN word[j] := s[i]; INC( j ) END; - INC( i ); - END; - word[j] := 0X; pos := i; - (* Out.Ln(); Out.String("ReadUntil: pos : "); Out.Int(pos,5); Out.String("word : ");Out.String(word); *) - - IF (s[i] # stop) THEN - eor := TRUE; - (* Out.Ln(); Out.String("ReadUntil : stop character |"); Out.Char(stop); Out.String("| not found."); *) END; - END ReadUntil; - - PROCEDURE FindChar*( s: ARRAY OF CHAR; VAR pos: LONGINT; c: CHAR; VAR eor: BOOLEAN ); - (* Returns the position of the next occurence of character c in the string "s" starting at position "pos". - When no letter has been found *) - VAR i: LONGINT; - BEGIN - i := pos; - WHILE (s[i] # ">") & (s[i] # c) DO INC( i ) END; - IF (s[i] = c) THEN pos := i; ELSE eor := TRUE END; - END FindChar; - PROCEDURE Max*( i, j: LONGINT ): LONGINT; - BEGIN - IF i >= j THEN RETURN i ELSE RETURN j END; - END Max; - - PROCEDURE Min*( i, j: LONGINT ): LONGINT; - BEGIN - IF i <= j THEN RETURN i ELSE RETURN j END; - END Min; -PROCEDURE ExtractDigits*( sin: ARRAY OF CHAR; VAR sout: ARRAY OF CHAR ); - (* finds the first sequence of digits in a string *) - VAR i, j: LONGINT; - BEGIN - i := 0; - IF ~Strings.IsDigit( sin[i] ) THEN - i := 1; - WHILE ( i < LEN(sin) ) & ~Strings.IsDigit( sin[i] ) DO INC( i ) END - END; - (* sin[i] is a digit *) - j := 0; - WHILE ( i < LEN(sin) ) & Strings.IsDigit( sin[i] ) DO sout[j] := sin[i]; INC( i ); INC( j ) END; - sout[j] := 0X; - END ExtractDigits; - - PROCEDURE ExtractInt*( s: ARRAY OF CHAR ): INTEGER; - (* Converts String to INTEGERr s. *) - VAR res: LONGINT; shortres: INTEGER; - BEGIN - Strings.StrToInt( s, res ); shortres := SHORT( res ); RETURN shortres; - END ExtractInt; -(* PROCEDURE keytopsv* (key : ARRAY OF CHAR; c : CHAR; VAR p,s,v : LONGINT); - (* splits key into components : part, staff, voice *) - VAR i,j : LONGINT; pe : ARRAY 4 OF CHAR; - BEGIN - i := 0; WHILE key[i] # c DO pe[i] := key[i]; INC(i) END; - Strings.StrToInt(pe,p); - INC(i); s := ORD(key[i]) - 48; v := ORD(key[i + 2]) - 48; - - - END keytopsv; *) -(* PROCEDURE keytopsm* (key : ARRAY OF CHAR; c : CHAR; VAR p,s,m : LONGINT); - VAR i,j : LONGINT; pe : ARRAY 8 OF CHAR; - BEGIN - i := 0; WHILE key[i] # c DO pe[i] := key[i]; INC(i) END; - Strings.StrToInt(pe,p); - INC(i); s := ORD(key[i]) - 48; i := i + 2; - IF key[i] = "0" THEN WHILE key = "0" DO INC(i) END; END; - j := i; - WHILE key[i] # c DO pe[i-j] := key[i];INC(i) END; - Strings.StrToInt (pe,m); - - - END keytopsm; *) - -(* PROCEDURE psv2String*( part, staff, voice: LONGINT; VAR key: ARRAY OF CHAR ); - (* stores part staff voice in a string separated by "/" *) - VAR res: ARRAY 32 OF CHAR; partc : ARRAY 5 OF CHAR; - BEGIN - IF part < 10 THEN key[0] := "0"; key[1] := 0X; END; - Strings.IntToStr( part, partc ); Strings.Append(key,partc); - Strings.AppendCh(key,"/");Strings.IntToStr( staff, res ); Strings.Append( key, res ); - Strings.AppendCh(key,"/"); - Strings.IntToStr( voice, res ); Strings.Append( key, res ); - END psv2String; - PROCEDURE psmv2String*( part, staff, voice, measure : LONGINT; VAR key: ARRAY OF CHAR ); - (* stores part/ staff/ voice/ measure in a string separated by "/" *) - - VAR res: ARRAY 32 OF CHAR; partc : ARRAY 5 OF CHAR; - BEGIN - fill0 (part,2,partc); Strings.Append(key,partc); - Strings.AppendCh(key,"/");Strings.IntToStr( staff, res ); Strings.Append( key, res ); - Strings.AppendCh(key,"/"); - fill0 ( measure,4, res ); Strings.Append( key, res ); - Strings.AppendCh(key,"/"); - Strings.IntToStr( voice, res ); Strings.Append( key, res ); - END psmv2String; - - PROCEDURE mpsvn2String*( measure, part, staff, voice, note : LONGINT; VAR key: ARRAY OF CHAR ); - (* stores part/ staff/ voice/ measure in a string separated by "/" *) - (* Vorsicht Sortierung wie WritePmx *) - VAR res: ARRAY 32 OF CHAR; partc : ARRAY 5 OF CHAR; - BEGIN - fill0 ( measure,4, res ); Strings.Append( key, res ); Strings.AppendCh(key,"/"); - loesch(res); - fill0 (2-part,2,res); Strings.Append(key,res); Strings.AppendCh(key,"/"); - loesch(res); - Strings.IntToStr( 2-staff, res ); Strings.Append( key, res ); Strings.AppendCh(key,"/"); - loesch(res); - Strings.IntToStr( 4-voice, res ); Strings.Append( key, res ); Strings.AppendCh(key,"/"); - loesch(res); - fill0(note,2,res); Strings.Append( key, res ); Strings.AppendCh(key,"/"); - - - END mpsvn2String; *) - - PROCEDURE percussionclef* (ps : LONGINT; VAR perclef, perline : ARRAY OF CHAR); - VAR psstring : ARRAY 4 OF CHAR; - BEGIN - - COPY ("\\setclefsymbol{",perclef); Strings.IntToStr(ps,psstring); - Strings.Append(perclef,psstring);Strings.Append(perclef,"}\drumclef\"); - COPY ("\\setlines{",perline); Strings.Append(perline,psstring);Strings.Append (perline,"}{1}\"); - END percussionclef; - PROCEDURE left*( rec: ARRAY OF CHAR; anz: LONGINT; pat: ARRAY OF CHAR ): BOOLEAN; - VAR i: LONGINT; res: BOOLEAN; - BEGIN - i := 0; res := TRUE; - WHILE i < anz DO res := res & (pat[i] = rec[i]); INC( i ) END; - RETURN res; - END left; -PROCEDURE FilterTeX*( in: ARRAY OF CHAR; VAR out: ARRAY OF CHAR ); - (* Removes certain characters like "&", "_" and "^" which may caus trouble in the TeX compilation; *) - VAR i, j: LONGINT; - BEGIN - i := 0; j := 0; - WHILE (i < Strings.Length( in )) DO - IF (in[i] # "&") & (in[i] # "_") & (in[i] # "^") THEN out[j] := in[i]; INC( j ) END; - INC( i ); - END; - END FilterTeX; - PROCEDURE fill0* (in : LONGINT; outdigits : LONGINT; VAR out : ARRAY OF CHAR); - (* fills a positive integer "in" from left with zeros up to "outdigits" digits. *) - VAR i, indigits : LONGINT; inc : ARRAY 12 OF CHAR; - BEGIN - Strings.IntToStr(in,inc); indigits := Strings.Length(inc); i := indigits; - WHILE i < outdigits DO out[i-indigits] := "0"; INC(i); END; - Strings.Append(out,inc); - END fill0; - PROCEDURE ReadUntilTx*( VAR R: Files.Rider; stop: CHAR; VAR s: ARRAY OF CHAR ); - (* Reads from a given file position until a stop character and stores in string, Mike Spivey. *) - VAR i: LONGINT; c: CHAR; - BEGIN - Files.Read( R, c ); i := 0; - WHILE ~R.eof & (c # stop) DO - IF ~WhiteSpace( c ) THEN s[i] := c; INC(i); END; - Files.Read( R, c ) - END; - s[i] := c; s[i+1] := 0X - END ReadUntilTx; -(*old version until 12.08.2020 - PROCEDURE ReadUntilTx*( VAR R: Files.Rider; stop: CHAR; VAR s: ARRAY OF CHAR ); - (* Reads from a given file position until a stop character and stores in string. *) - VAR i: LONGINT; c: CHAR; - BEGIN - Files.Read( R, c ); i := 0; - REPEAT IF ~WhiteSpace(c) THEN s[i] := c; INC(i); END; Files.Read(R,c); - - UNTIL R.eof OR ( c = stop ); - - s[i] := c; s[i+1] := 0X; - - END ReadUntilTx; *) - PROCEDURE WhiteSpace ( c : CHAR) : BOOLEAN; - VAR ws : BOOLEAN; - BEGIN - ws := (c = BLANK) OR ( c = TAB ) OR ( c = CR ) OR ( c = NL ); - RETURN ws; - END WhiteSpace; - PROCEDURE testws*; - VAR f : Files.File; R : Files.Rider; c : CHAR; rec : ARRAY 256 OF CHAR; i : LONGINT; - BEGIN - f := Files.Old ("d:/musix/xml/vivaldi.xml"); - Files.Set(R,f,0); - WHILE ~R.eof DO - Files.Read (R,c); - IF c # "<" THEN REPEAT Files.Read(R,c) UNTIL R.eof OR (c = "<" ); END; - i := 0; rec[i] := c; REPEAT Files.Read(R,c); INC(i); rec[i] := c; UNTIL R.eof OR (c = ">" ); - rec[i+1] := 0X; - Out.Ln();Out.String(rec); - END; - END testws; - PROCEDURE ReadRecn1*( VAR R: Files.Rider; VAR rec: ARRAY OF CHAR; VAR length: LONGINT ); - (* Reads one record from the MusicXML file. removes leading BLANKs and TABs and CR, NL *) - VAR i: LONGINT; c: CHAR; - BEGIN - Files.Read( R, c ); - IF WhiteSpace(c) THEN REPEAT Files.Read(R,c) UNTIL ~WhiteSpace(c); END; - i := 0; - WHILE (~R.eof) & (i < LEN( rec ) - 1) & (c # CR) & (c # NL) DO rec[i] := c; Files.Read( R, c ); INC( i ) END; - rec[i] := 0X; length := i; - END ReadRecn1; - PROCEDURE ReadRecn*( VAR R: Files.Rider; VAR rec: ARRAY OF CHAR; VAR length: LONGINT ); - (* Reads one record from the MusicXML file. removes leading BLANKs and TABs and CR, NL *) - VAR i: LONGINT; c: CHAR; - BEGIN - Files.Read( R, c ); - IF (c = NL) THEN Files.Read( R, c ); END; - (* Remove leading Blanks and Tabs *) ; - IF (c = BLANK) OR (c = TAB) THEN - WHILE (c = BLANK) OR (c = TAB) DO Files.Read( R, c ); END; - END; - i := 0; - WHILE (~R.eof) & (i < LEN( rec ) - 1) & (c # CR) & (c # NL) DO rec[i] := c; Files.Read( R, c ); INC( i ) END; - rec[i] := 0X; length := i; - END ReadRecn; - - PROCEDURE SkipUntilPattern*( VAR R: Files.Rider; pattern: ARRAY OF CHAR ); - (* Skips records from XML file until pattern is reached. *) - VAR pos: LONGINT; - rec: ARRAY 256 OF CHAR; - BEGIN - pos := -1; - WHILE ~R.eof & (pos = -1) DO (* ????????????????????? pos # -1 *) - ReadRec( R, rec ); (* Out.Ln();Out.String("skip : ");Out.String(rec); *) - Strings.Search( pattern, rec, pos ) - END; - END SkipUntilPattern; - PROCEDURE ReadRec*( VAR R: Files.Rider; VAR rec: ARRAY OF CHAR ); - (* Reads one record from the MusicXML file. removes leading BLANKs and TABs and CR NL *) - VAR i: LONGINT; c: CHAR; - BEGIN - SkipTextChar( R, BLANK, c ); i := 0; - WHILE (~R.eof) & (i < LEN( rec ) - 1) & (c # 0DX) & (c # 0AX) DO - IF (c # TAB) THEN rec[i] := c; INC( i ); END; - Files.Read( R, c ) - END; - rec[i] := 0X; - IF (c = 0DX) OR (i = LEN( rec ) - 1) THEN - WHILE c # 0AX DO Files.Read( R, c ); END; - END; - - END ReadRec; - - PROCEDURE SkipTextChar*( VAR R: Files.Rider; skip: CHAR; VAR found: CHAR ); - (* skips over leading characters , e.g. Blanks in an XML-File and returns the first character # "skip"*) - VAR c: CHAR; - BEGIN - Files.Read( R, c ); - IF (c = skip) THEN - WHILE ~R.eof & (c = skip) DO Files.Read( R, c ); END; - IF (c # skip) THEN found := c; ELSE found := 0X END; - ELSE found := c - END; - END SkipTextChar; - PROCEDURE ReadfromtoString*( VAR s: ARRAY OF CHAR; from, to: LONGINT; VAR between: ARRAY OF CHAR); - (* Reads the substring "between" inside string "s", starting with "from" and ending with "to" -1 . *) - VAR k, i: LONGINT; ltins: BOOLEAN; - BEGIN - i := from; k := 0; ltins := FALSE; - WHILE (k < LEN( between ) ) & (i < to) DO (* ltins := ltins OR (s[i] = "<") OR (s[i] = ">"); *) - between[k] := s[i]; INC( k ); INC( i ); - END; - between[k] := 0X; - (* IF ltins THEN loesch( between ) END; *) - END ReadfromtoString; - PROCEDURE FindName*( s: ARRAY OF CHAR; VAR pos: LONGINT; VAR name: ARRAY OF CHAR; VAR eor: BOOLEAN ); - BEGIN - FindLetter( s, pos, eor ); - IF ~eor THEN ReadUntil( s, pos, "=", name, eor ); END; - END FindName; - - PROCEDURE FindValue*( s: ARRAY OF CHAR; VAR pos: LONGINT; VAR value: ARRAY OF CHAR; VAR eor: BOOLEAN ); - VAR - BEGIN - FindChar( s, pos, 22X, eor ); (* Out.Ln(); Out.String("FindValue: pos : "); Out.Int(pos,5); *) INC( pos ); - IF ~eor THEN ReadUntil( s, pos, 22X, value, eor ); END; - END FindValue; - PROCEDURE AnalyzeTag2*( rec: ARRAY OF CHAR; VAR tag, endtag, between: ARRAY OF CHAR; - VAR names, values: ARRAY OF ARRAY OF CHAR; VAR novalues: LONGINT ); - (* extracts the information from MusicXML-tags. - Depending on which tag, we have a number of name-value-pairs as well as the word between ">" and "<"*) - VAR i, j, k, from, to, pos, isave: LONGINT; eor: BOOLEAN; - BEGIN - i := 0; loesch( tag ); loesch( endtag ); loesch( between ); novalues := 0; j := 0; - WHILE j < 10 DO loesch( names[j] ); loesch( values[j] ); INC( j ) END; - (* Out.Ln(); Out.String("AnalyzeTag2");Out.String(rec); Out.Int(ORD(rec[0]),5);Out.Ln(); *) - WHILE (i < Strings.Length( rec )) & (rec[i] # 20X) & (rec[i] # ">") (* Find Blank if it exists *) - DO - tag[i] := rec[i]; INC( i ); - END; - isave := i; - IF (rec[i] = 20X) THEN - IF rec[i + 1] = "/" THEN tag[i] := "/"; INC( i ); END; - tag[i] := ">"; tag[i + 1] := 0X; k := 0; - - eor := FALSE; pos := i; j := 0; - WHILE ~eor DO - FindName( rec, pos, names[j], eor ); - (* Out.Ln();Out.String(" new algorithm : "); Out.String(" pos : "); Out.Int(pos,5); *) - IF ~eor THEN FindValue( rec, pos, values[j], eor ); END; - (* Out.String(names[j]); Out.String(values[j]); *) - - INC( j ); - END; - i := pos; - - WHILE (i < Strings.Length( rec )) & (rec[i] # ">") DO INC( i ); - END; - novalues := j - 1; - - ELSE tag[isave] := ">"; tag[isave + 1] := 0X; - END; - - close( tag, endtag ); from := i + 1; to := from; Strings.Search( endtag, rec, to ); loesch( between ); - IF (to > -1) THEN ReadfromtoString( rec, from, to, between ); END; - (* Out.String(tag); Out.Char("|"); Out.String(endtag); Out.Char("|");Out.String(between); Out.Char("|"); - i := 0; WHILE i < novalues DO Out.String(names[i]);Out.Char("="); Out.String(values[i]); INC(i); END; *) - END AnalyzeTag2; - PROCEDURE FindIProperty*( n: Tag; tagname, pattern: ARRAY OF CHAR; VAR res: LONGINT ); - (* searches n.tagname for the occurrence of "pattern" and finds Integer value of "pattern" *) - VAR endtag: ARRAY 32 OF CHAR; - BEGIN - - IF (n.tagname = tagname) THEN - COPY( n.endtag, endtag ); - - WHILE (n.next # NIL ) & (n.tagname # endtag) & (n.tagname # pattern) DO - - n := n.next - END; - IF (n.tagname = pattern) THEN Strings.StrToInt( n.between, res ); ELSE res := 1 END; (* komischer ELSE Fall *) - - ELSE (* Out.Ln(); Out.String( " FindProperty : object is not a " ); Out.String( tagname ); *) - END; - - END FindIProperty; - - PROCEDURE FindProperty*( n: Tag; tagname, pattern: ARRAY OF CHAR; VAR res: LONGINT ); - (* Finds the value of an integer property, corresponding to "pattern", e.g. "staff" or "voice". *) - VAR endtag: ARRAY 32 OF CHAR; - BEGIN - - IF (n.tagname = tagname) THEN - COPY( n.endtag, endtag ); - - WHILE (n.next # NIL ) & (n.tagname # endtag) & (n.tagname # pattern) DO - (* IF (n.tagname = directiontag) THEN OutTag( n ) END; *) - n := n.next - END; - IF (n.tagname = pattern) THEN res := 1; ELSE res := -1 END; - - END; - - END FindProperty; - PROCEDURE testmakekey*(maxpart, measure : LONGINT; VAR keytotal : ARRAY OF CHAR); - VAR keystr : ARRAY 16 OF CHAR; i : LONGINT; - BEGIN -(* Out.Ln(); Out.String("1testmake"); - i := 1; WHILE i <= maxpart DO - Out.Ln(); Out.Int(i,5); Out.Int (akeys[i],5); Out.Int(mkeys[i],5); INC(i); END; *) - - i := maxpart; loesch(keytotal); keytotal[0] := "K"; keytotal[1] := 0X; - WHILE ( i > 0 ) DO - loesch(keystr); - IF ( measure = 1 ) THEN - IF (akeys[i] # akeys[maxpart]) THEN - Makekeystr(maxpart,i,akeys[i],keystr); END; - - ELSE - IF ( mkeys[i] # mkeys[maxpart] ) THEN - Makekeystr(maxpart,i,mkeys[i],keystr); END; - - - END; - - Strings.Append(keytotal,keystr); - DEC(i); -END; IF (keytotal = "K") THEN keytotal[0] := 0X END; - (* Out.Ln();Out.String("keytotal : ");Out.String(keytotal);*) - END testmakekey; - - PROCEDURE Makekeystr* (maxpart,part : LONGINT; keys : INTEGER; VAR keystr : ARRAY OF CHAR); - VAR dummy : ARRAY 4 OF CHAR; - BEGIN - COPY ("Ki" , keystr); IF ( part # maxpart ) THEN COPY ("i", keystr); END; - Strings.IntToStr(maxpart-part+1,dummy); Strings.Append(keystr,dummy); - Strings.Append(keystr,"+0"); - IF ( keys >= 0 ) THEN Strings.AppendCh(keystr,"+"); END; - Strings.IntToStr( keys, dummy ); - Strings.Append( keystr, dummy ); - - END Makekeystr; - PROCEDURE metron2PMX* ( beatunit : ARRAY OF CHAR; perminute : ARRAY OF CHAR; - VAR sout :ARRAY OF CHAR); - (* Generates the Metronome data for PMX. *) - BEGIN - loesch (sout); - -(* COPY ("\zcharnote{12}{\metron", sout) ; *) - COPY ("\metron", sout) ; - - (* Out.Ln(); Out.String(sout); *) - IF beatunit = "half" THEN Strings.Append (sout,"{\hu}{") - ELSIF beatunit = "quarter" THEN Strings.Append(sout,"{\qu}{") - ELSIF beatunit = "eighth" THEN Strings.Append(sout,"{\cu}{"); - ELSE - Out.Ln(); - Out.String("metron2PMX : beatunit "); - Out.String(beatunit); Out.String("unknown") - END; - Strings.Append(sout,perminute); Strings.AppendCh (sout,"}"); - ; - - END metron2PMX; -END b.testMinDist |