* Program....: BCCD.PRG * Version....: 5.0 * Author.....: Stephen R.M. Jones * Date.......: 11 October 2007 * Notice.....: Copyright (c) 2007 Stephen Jones, All Rights Reserved. * Compiler...: FoxPro 2.6 * Abstract...: Import abc file and analyze push and pull movements required * for C#/D and B/C button accordion systems * * Could be adapted to include C/C# and D/D# etc. either by adding * the hardcoding as used at present or using a lookup table for pushes and pulls * * This version assumes that the player will always use the "magic notes" * to reduce bellows movement - not necessarily so in practice. Hence the result * is described as "minimum bellows movements". * * A magic note means a note that is available in both bellows directions - * F# and C# on a C#/D system, E and B on a B/C system. * * The program assumes that a magic note is taken in the same movement * as the previous note. This won't affect the numbers of pushes and pulls because * * draw - magic note - draw | press - magic note - press * * will give one movement and both * * draw - magic note - press | press - magic note - draw * * will give two regardless of the direction assigned to the magic note. * * Method: parse each line in the source .abc file and write to a new .abd file * * If the line contains a key signature field (K:), create one string containing * letters of all notes to be sharpened, and one containing those to be flattened * * If the line contains a tune number field (X:), except for the first instance, * write the number of bellows movements for each system to the output file and * reset counters for the tune * * If the line presumably contains notes (i.e. is not a header field, or a comment line, or a line * containing only text in quotes (e.g. "Variation played by Andrew Mac Namara")), * after writing the line to the output file, build lines indicating push and pull * movements under each note by parsing each character in the line. * * For any character that is not a note (e.g. | : , ^ = _) or characters in quotes (e.g. "Bmin") * assign a space to these push/pull lines. * * For a sharp, flat or natural sign, set a variable indicating that the next note is to * be altered and, in order to continue altering all subsequent unsigned notes in the same bar, * add the note to a temporary string for sharps, flats or naturals in the current bar. Reset * the string each time a bar line delimiter is encountered. * Declare variables *------------------- private lcInput ,; lcOutput ,; lcOutput2 ,; lcOutput3 ,; lcResultTbl ,; lcResultIdx ,; lcAlias ,; lcOKLine1 ,; lcSetExact ,; lcPrgName ,; lcPushChar,; lcPullChar ,; lcRptChar ,; lcTuneTitle, ; lcMaxPCStr, ; lcMinPCStr,; lnInpHandl ,; lnOutHandl ,; lnOut2Handl ,; lnTuneCnt ,; lnStartSecs ,; lnEndSecs ,; lnMaxPerCent ,; lnMinPerCent ,; llGotTitle ,; llIsFlat, ; llIsNat, ; llIsSharp, ; llSkipQuo ,; llSkipGrace ,; lcChar = ,; llcLastCSD ,; lcLastBNC ,; lnCSDMoves ,; lnBNCMoves ,; lnCSDMovTot ,; lnBNCMovTot .; lcKeySig ,; lcKeyFlats ,; lcKeySharps ,; lcAccNats, ; lcAccSharps, ; lcAccFlats * Get input file name *-------------------------------- lcInput=getfile([abc],[Choose your source abc file]) && FoxPro file chooser function, ; display only .abc files, return filename ; or blank if nothing chosen if empty(lcInput) return endif lcOutPut = substr(lcInput, 1, at(".", lcInput)) + [TMP] && output file - same name, new extension lcOutPut2 = substr(lcInput, 1, at(".", lcInput)) + [SUM] && output file - same name, new extension lcOutPut3 = substr(lcInput, 1, at(".", lcInput)) + [ABD] && output file - same name, new extension lcResultTbl = substr(lcInput, 1, at(".", lcInput)) + [DBF] lcResultIdx = substr(lcInput, 1, at(".", lcInput)) + [CDX] jcTemp = substr(lcinput, 1, rat([.], lcinput)-1) lcAlias = substr(jcTemp, rat([\], jcTemp)+1) lcPrgName = [BCCD.PRG] lcPushChar = [p] && character to indicate push or press lcPullChar = [d] && character to indicate draw or pull lcRptChar = [ ] && character to indicate same bellows direction lcChar = [] && parsing character lcLastCSD = [] && remember last C#D move - press or draw lcLastBNC = [] && ditto B/C lcKeySig = "DMAJ" && default in case file contains none lcKeyFlats = [] && string containing notes to be flattened depending on key sig lcKeySharps = [] && string containing notes to be sharpened depending on key sig lcAccNats = [] && string containing nats for remainder of current bar lcAccSharps = [] && string containing sharps for remainder of current bar lcAccFlats = [] && string containing shars for remainder or current bar lcMaxPCStr = [] lcMinPCStr = [] lnMaxPerCent = 0 lnMinPerCent = 0 lnCSDMoves = 0 && counter - C#D moves for tune lnBNCMoves = 0 && counter - B/C moves for tune lnCSDMovTot = 0 && counter - C#D moves for entire file lnBNCMovTot = 0 && counter - B/C moves for entire file llIsFlat = .f. && if .t., next note is to be flattened llIsNat = .f. && if .t., next note is natural llIsSharp = .f. && if .t., next note is to be sharpened llSkipQuo = .f. && if .t., we are between quote marks and skipping characters llSkipGrace = .f. && if .t. we are between { and } and skipping characters llGotTitle = .f. && set to .t. when we find a title for current tune lnInpHandl = fopen(lcInput) && open source file for low-level read functions lnOutHandl = fcreate(lcOutPut) && create output file for read and write functions lnOut2Handl = fcreate(lcOutPut2) && create output file for read and write functions lnOut3Handl = fcreate(lcOutPut3) && create output file for read and write functions lnTuneCnt = 0 store seconds() to lnStartSecs, lnEndSecs && display elapsed time at end *wait window str(lnInpHandl) if lnInpHandl = -1 or lnOutHandl = -1 ; or lnOut2Handl = -1 or lnOut3Handl = -1 && failed to open or create files && attempt to close open files, alert user and abort =sorry([Couldn't open input or output file...]) =fclose(lnInpHandl) =fclose(lnOutHandl) return endif lcSetExact = set("exact") && save setting. set exact off and inlist() comparisons fail set exact on selec 0 create table (lcResultTbl) ; (nTuneNo N(5,0) , cTitle C(40), cKeySig C(5), nPercent N(5,0), nCSD N(10,0), nBNC N(10,0) ) * Read each line in Input file and process accordingly *--------------------------------------------- do while not feof(lnInpHandl) && continue until we hit end-of-file lcLine = fgets(lnInpHandl) && read next entire line in input file do case case left(lcLine,2) = "X:" && start of tune if lnTuneCnt > 0 do flush && reset counters and write results before continuing endif lnTuneCnt = lnTuneCnt + 1 lnNoInFile = val(trim(substr(lcLine,3))) if lnTuneCnt % 100 = 0 wait window nowait [Tune no. ] + ltrim(str(lnTuneCnt)) + [...] endif if lnNoInFile <> 0 and lnNoInFile <> lnTuneCnt lcLine = [X:] + ltrim(str(lnTuneCnt)) + [ (no. in original file: ] + trim(substr(lcLine,3)) + [)] endif =fputs(lnOutHandl, lcLine) && write line to output file loop && skip rest of statements, start again at do while loop case left(lcLine,2) = "K:" lcKeySig = getkeysig(; upper(trim(chrtran(substr(lcLine, at(":",lcLine)+1),[ ],[]))); ) && strip spaces from portion of line to right of :, convert to uppercase && anad pass to getkeysig() && getkeysig() is a function in this file to assign key signature and sharps and flats =fputs(lnOutHandl, lcLine) if [TEST.ABC] $ lcInput =fputs(lnOutHandl, [% Sharps: ] + lcKeySharps) =fputs(lnOutHandl, [% Flats: ] + lcKeyFlats) endif loop case llGotTitle = .f. and left(lcLine,2) = [T:] llGotTitle = .t. lcTuneTitle = substr(trim(lcLine),3) if lower(right(lcLine, 5)) = ", the" lcTuneTitle = "The " + substr(lcTuneTitle, 1, len(lcTuneTitle)-5) endif =fputs(lnOutHandl, lcLine) case lnTuneCnt = 0 or ; not "|" $ lcLine or ; "%" $ left(lcLine,5) or ; empty(lcLine) or ; (len(lcLine) >=2 and isalpha(lcLine) and substr(lcLine,2,1) = ":") or ; (left(lcLine,1) = ["] and right(lcLine,1) = ["]) * do nothing =fputs(lnOutHandl, lcLine) loop otherwise =fputs(lnOutHandl, space(7) + lcLine) LcLine2 = [% C#D: ] lcLine3 = [% B/C: ] for i = 1 to len(lcLine) lcChar = substr(lcLine, i, 1) if llskipquo if lcChar = ["] llskipquo = .f. endif else if lcChar = ["] llskipquo = .t. endif endif if llskipGrace if lcChar = [}] llSkipGrace = .f. endif else if lcChar = [{] llSkipGrace = .t. endif endif if lcChar = [|] && new bar, reset all accidentals store [] to ; lcAccNats, lcAccSharps, lcAccFlats endif if llSkipQuo or ; llSkipGrace or ; not inlist(upper(lcChar), [A], [B], [C], [D], [E], [F], [G]) LcLine2 = lcLine2 + [ ] lcLine3 = lcLine3 + [ ] do case case lcChar = "=" llIsNat = .t. case lcChar = "^" llIsSharp = .t. case lcChar = "_" llIsFlat = .t. endcase else do case case llIsNat if not upper(lcChar) $ lcAccNats lcAccNats = lcAccNats + upper(lcChar) endif lcAccFlats = chrtran(lcAccFlats, upper(lcChar), []) lcAccSharps = chrtran(lcAccSharps, upper(lcChar), []) lcLookup = upper(lcChar) case upper(lcChar) $ lcAccNats and not llIsSharp and not llIsFlat lcLookup = upper(lcChar) case llIsSharp if not upper(lcChar) $ lcAccSharps lcAccSharps = lcAccSharps + upper(lcChar) endif lcAccFlats = chrtran(lcAccFlats, upper(lcChar), []) lcAccNats = chrtran(lcAccNats, upper(lcChar), []) lcLookup = upper(lcChar) + "#" case upper(lcChar) $ lcAccSharps and not llIsNat and not llIsFlat lcLookup = upper(lcChar) + "#" case upper(lcChar) $ lcKeySharps and not llIsNat and not llIsFlat lcLookup = upper(lcChar) + "#" case llIsFlat if not upper(lcChar) $ lcAccFlats lcAccFlats = lcAccFlats + upper(lcChar) endif lcLookup = upper(lcChar) + "b" case upper(lcChar) $ lcAccFlats and not llIsNat and not llIsSharp lcLookup = upper(lcChar) + "b" case (not llIsNat and not llIsSharp and upper(lcChar) $ lcKeyFlats) lcLookup = upper(lcChar) + "b" otherwise lcLookup = upper(lcChar) endcase lcChar = getpress(lcLookup, "CSD") if lcChar==lcLastCSD lcLine2 = lcLine2 + lcRptChar else lcLine2 = lcLine2 + lcChar lnCSDMoves = lnCSDMoves + 1 lnCSDMovTot = lnCSDMovTot + 1 endif lcLastCSD = lcChar lcChar = getpress(lcLookup, "BNC") if lcChar==lcLastBNC lcLine3 = lcLine3 + lcRptChar else lcLine3 = lcLine3 + lcChar lnBNCMoves = lnBNCMoves + 1 lnBNCMovTot = lnBNCMovTot + 1 endif lcLastBNC = lcChar store .f. to llIsFlat, llIsNat, llIsSharp endif endfor =fputs(lnOutHandl, LcLine2) =fputs(lnOutHandl, lcLine3) =fputs(lnOutHandl, []) && space(7) + repl([_], len(lcLine))) endcase enddo && do while not end of file loop do flush * Processing finished: insert explanation, then results from summary table *-------------------------------------------------------------------------> lnEndSecs = seconds() lcOKLine1 = ltrim(str(lnTuneCnt)) + [ tune] + iif(lnTuneCnt <> 1, [s], []) + ; [ scanned in ] + ltrim(str(lnEndSecs - lnStartSecs,12,4)) + [ seconds.] =fputs(lnOut2Handl, [% ] + repl([-], 80)) =fputs(lnOut2Handl, [% Source file ] + lcInput) =fputs(lnOut2Handl, [% processed by ] + lcPrgName + [ on]) =fputs(lnOut2Handl, [% ] + longdate(date(), "E") + [ at ] + time() + [.]) =fputs(lnOut2Handl, [% ] + lcOKLine1) =fputs(lnOut2Handl, []) =fputs(lnOut2Handll,[% ] + lcPrgName + [ written in FoxPro 2.6 by Steve Jones.]) =fputs(lnOut2Handl, [% Please send comments or bug reports to whistle@rogermillington.com]) =fputs(lnOut2Handl, [% ] + repl([-], 80)) =fputs(lnOut2Handl, []) =fputs(lnOut2Handl, [% This program provides a rough analysis of the number of]) =fputs(lnOut2Handl, [% changes in bellows direction required to play the listed]) =fputs(lnOut2Handl, [% tunes on a 2-row diatonic accordion in C#/D and B/C.]) =fputs(lnOut2Handl, [% See the commented ABC code for each tune below the results.]) =fputs(lnOut2Handl, []) =fputs(lnOut2Handl, [% The analysis is rudimentary, making no allowance for personal]) =fputs(lnOut2Handl, [% playing styles or changes to the settings or noted ornaments ]) =fputs(lnOut2Handl, [% that might ordinarily be made by box players interpreting any ]) =fputs(lnOut2Handl, [% of the tunes. In addition, the program assumes that players ]) =fputs(lnOut2Handl, [% will always use the "magic notes" that are available in both ]) =fputs(lnOut2Handl, [% bellows directions to save a movement - obviously not the case]) =fputs(lnOut2Handl, [% in practice, as any player knows. ]) =fputs(lnOut2Handl, []) =fputs(lnOut2Handl, [% Still, the analysis demonstrates the minimum possible number of ]) =fputs(lnOut2Handl, [% bellows direction changes needed to play the tunes on these systems.]) =fputs(lnOut2Handl, [% For the sake of simplicity, this is done by assuming that a magic]) =fputs(lnOut2Handl, [% note is taken in the same bellows direction as the previous note.]) =fputs(lnOut2Handl, [% Again, while this might not reflect what a given box player would do]) =fputs(lnOut2Handl, [% (even if his or her aim were to minimize bellows movements), for the ]) =fputs(lnOut2Handl, [% purposesof the analysis, runs of three notes involving a magic note]) =fputs(lnOut2Handl, [% will always appear correctly, and the minimum number of direction ]) =fputs(lnOut2Handl, [% changes remains correct.]) =fputs(lnOut2Handl, []) =fputs(lnOut2Handl, [% What was the point of all this, you may ask? Modest programming ]) =fputs(lnOut2Handl, [% challenge, and to satisfy curiosity. :-)]) =fputs(lnOut2Handl, []) =fputs(lnOut2Handl, [% ] + repl([-], 80)) =fputs(lnOut2Handl, [% Minimum total bellows moves for ] + ltrim(str(lnTuneCnt)) + [ tunes in file ] + lcInput) =fputs(lnOut2Handl, [% C#D: ] + ltrim(str(lnCSDMovTot))) =fputs(lnOut2Handl, [% B/C: ] + ltrim(str(lnBNCMovTot))) =fputs(lnOut2Handl, [% Percentage: ] + ltrim(str(lnCSDMovTot / lnBNCMovTot * 100)) + [%]) =fputs(lnOut2Handl, []) =fputs(lnOut2Handl, [% Highest %: ] + lcMaxPCStr) =fputs(lnOut2Handl, [% Lowest %: ] + lcMinPCStr) =fputs(lnOut2Handl, [% ] + repl([-], 80)) =fputs(lnOut2Handl, []) select (lcAlias) index on nPerCent descending tag master =fputs(lnOut2Handl, [%] + space(64) + [Bellows movements]) =fputs(lnOut2Handl, [%] + padl([No.], 6) + padr([ Title], 42) + [Key ] + padr([%], 5) + ; padr([C/#D],7) + padr([B/C],10) ) =fputs(lnOut2Handl, [% ] + repl([-], 80)) scan && insert summary into main file lcLine = ; [%] + padl(ltrim(str(nTuneNo)),6) + [ ] + ; padr(trim(cTitle),40, [.]) +[ ] + proper(cKeySig) + ; [ ] + padl(ltrim(str(nPerCent)) + [% ],5) + ; [ ] + padl(ltrim(str(nCSD)),6) + ; [ / ] + ltrim(str(nBNC)) =fputs(lnOut2Handl, lcLine) endscan =fputs(lnOut2Handl, []) =fseek(lnOutHandl, 0) && move to bof() =fseek(lnOut2Handl, 0) && move to bof() do while not feof(lnOut2Handl) lcLine = fgets(lnOut2Handl) =fputs(lnOut3Handl, lcLine) enddo do while not feof(lnOutHandl) lcLine = fgets(lnOutHandl) =fputs(lnOut3Handl, lcLine) enddo =fclose(lnInpHandl) =fclose(lnOutHandl) =fclose(lnOut2Handl) =fclose(lnOut3Handl) select (lcAlias) use *=OK(; lcOKLine1 + repl(chr(13),2) + ; [Minimum total C#D bellows moves = ] + ltrim(str(lnCSDMovTot)) + chr(13) + ; [Minimum total B/C bellows moves = ] + ltrim(str(lnBNCMovTot)) + chr(13) + ; [Percentage = ] + ltrim(str(lnCSDMovTot / lnBNCMovTot * 100)) + [%]; ) modi comm (lcOutput3) && open output file in edit mode set exact &lcSetExact && restore setting return *----------------------------------------------------------* * Function....: getpress * Called by...: * * Abstract....: * * Returns.....: * * Parameters..: * * Notes.......: function GetPress *----------------------------------------------------------* parameter tcChar, tcSys * wait window timeout 0.1 tcChar *|if tcChar = "Bb" *| wait window tcCHar *|endif do case case tcSys = "CSD" do case case inlist(tcChar, [F#], [Gb]) && magic notes if empty(lcLastCSD) return lcPushChar else return lcLastCSD endif case inlist(tcChar, [C#], [Db]) && magic notes if empty(lcLastCSD) return lcPullChar else return lcLastCSD endif case inlist(tcChar, [D],[A],; [E#],[F],[G#],[Ab]) && push notes from both rows - magic notes return lcPushChar otherwise return lcPullChar endcase case tcSyS = "BNC" do case case inlist(tcChar, [B], [Cb]) if empty(lcLastBNC) return lcPullChar else return lcLastBNC endif case inlist(tcChar, [E], [Fb]) if empty(lcLastBNC) return lcPushChar else return lcLastBNC endif case inlist(tcChar, [C],[B#],[G],; [D#],[Eb],[F#],[Gb]) return lcPushChar otherwise return lcPullChar endcase endcase *eof() lookup *----------------------------------------------------------* * Procedure...: Flush * Called by...: * * Abstract....: * * Parameters..: * * Notes.......: procedure Flush *----------------------------------------------------------* * reset counters private jnPerCent jnPerCent = lnCSDMoves / lnBNCMoves * 100 * =fputs(lnOutHandl, []) =fputs(lnOutHandl, [% Minimum bellows moves in tune ] + ltrim(str(lnTuneCnt)) + ; iif(llGotTitle, [ (] + lcTuneTitle + [)], []) + [:]) =fputs(lnOutHandl, [% C#D: ] + ltrim(str(lnCSDMoves))) =fputs(lnOutHandl, [% B/C: ] + ltrim(str(lnBNCMoves))) =fputs(lnOutHandl, [% Percentage: ] + ltrim(str(jnPerCent)) + [%]) =fputs(lnOutHandl, []) * Insert results into summary database *-----------------------------> insert into (lcAlias) ; (nTuneNo, cTitle, cKeySig, nPercent, nCSD, nBNC) ; values ; (lnTuneCnt, lcTuneTitle, proper(lcKeySig), jnPerCent, lnCSDMoves, lnBNCMoves) *-----------------------------< lnCSDMovTot = lnCSDMovTot + lnCSDMoves lnBNCMovTot = lnBNCMovTot + lnBNCMoves if lnMaxPerCent = 0 or jnPerCent > lnMaxPerCent store jnPerCent to lnMaxPercent lcMaxPCStr = ltrim(str(lnMaxPerCent)) + [%] + iif(llGotTitle, [ (] + lcTuneTitle + [)], []) + [ - ] + lcKeySig endif if lnMinPerCent = 0 or jnPerCent < lnMinPerCent store jnPerCent to lnMinPercent lcMinPCStr = ltrim(str(lnMinPerCent)) + [%] + iif(llGotTitle, [ (] + lcTuneTitle + [)], []) + [ - ] + lcKeySig endif llGotTitle = .f. lcTuneTitle = [] lcLastCSD = "" lnCSDMoves = 0 lcLastBNC = "" lnBNCMoves = 0 RETURN *endproc (Flush) *----------------------------------------------------------* * Function....: GetKeySig * Called by...: * * Abstract....: * * Returns.....: * * Parameters..: * * Notes.......: function GetKeySig *----------------------------------------------------------* parameter tcKeyStr if len(tcKeyStr) = 1 or ( len(tcKeyStr) = 2 and inlist(right(tcKeyStr,1), [#], [B]) ) tcKeyStr = tcKeyStr + [MAJ] endif if right(tcKeyStr,1) = "M" tcKeyStr = tcKeyStr + "IN" && make sure we have "MIN" and not "M" else if right(tcKeyStr,2) = "MI" tcKeyStr = tcKeyStr + "N" && make sure we have "MIN" and not "MI" endif endif tcKeyStr = strtran(tcKeyStr, [IONIAN], [MAJ]) tcKeyStr = strtran(tcKeyStr, [ION], [MAJ]) tcKeyStr = strtran(tcKeyStr, [AEOLIAN], [MAJ]) tcKeyStr = strtran(tcKeyStr, [AEO], [MAJ]) if inlist(substr(tcKeyStr,2,1), [#], [B]) tcKeyStr = left(tcKeyStr,5) else tcKeyStr = left(tcKeyStr,4) endif do case case inlist(tcKeyStr, ; [CMAJ], [DDOR], [EPHR], [FLYD], [GMIX], [AMIN], [BLOC]) && 0 accidentals lcKeySharps = "" lcKeyFlats = "" case inlist(tcKeyStr, ; [GMAJ], [ADOR], [BPHR], [CLYD], [DMIX], [EMIN], [F#LOC]) && 1 sharp lcKeySharps = "F" lcKeyFlats = "" case inlist(tcKeyStr, ; [DMAJ], [EDOR], [F#PHR], [GLYD], [AMIX], [BMIN], [C#LOC]) && 2 sharps lcKeySharps = "FC" lcKeyFlats = "" case inlist(tcKeyStr, ; [AMAJ], [BDOR], [C#PHR], [DLYD], [EMIX], [F#MIN], [G#LOC]) && 3 sharps lcKeySharps = "FCG" lcKeyFlats = "" case inlist(tcKeyStr, ; [EMAJ], [F#DOR], [G#PHR], [ALYD], [BMIX], [C#MIN], [D#LOC]) && 4 sharps lcKeySharps = "FCGD" lcKeyFlats = "" case inlist(tcKeyStr, ; [BMAJ], [C#DOR], [D#PHR], [ELYD], [F#MIX], [G#MIN], [A#LOC]) && 5 sharps lcKeySharps = "FCGDA" lcKeyFlats = "" case inlist(tcKeyStr, ; [F#MAJ], [G#DOR], [A#PHR], [BLYD], [C#MIX], [D#MIN], [E#LOC]) && 6 sharps lcKeySharps = "FCGDAE" lcKeyFlats = "" case inlist(tcKeyStr, ; [C#MAJ], [D#DOR], [E#PHR], [F#LYD], [G#MIX], [A#MIN], [B#LOC]) && 7 sharps lcKeySharps = "FCGDAEB" lcKeyFlats = "" case inlist(tcKeyStr, ; [FMAJ], [GDOR], [APHR], [BBLYD], [CMIX], [DMIN], [ELOC]) && 1 flat lcKeySharps = "" lcKeyFlats = "B" case inlist(tcKeyStr, ; [BBMAJ], [CDOR], [DPHR], [EBLYD], [FMIX], [GMIN], [ALOC]) && 2 flats lcKeySharps = "" lcKeyFlats = "BE" case inlist(tcKeyStr, ; [EBMAJ], [FDOR], [GPHR], [ABLYD], [BBMIX], [CMIN], [DLOC]) && 3 flats lcKeySharps = "" lcKeyFlats = "BEA" case inlist(tcKeyStr, ; [MAJ], [DOR], [PHR], [LYD], [MIX], [MIN], [LOC]) && 4 flats lcKeySharps = "" lcKeyFlats = "BEAD" case inlist(tcKeyStr, ; [DBMAJ], [EBDOR], [FPHR], [GBLYD], [ABMIX], [BBMIN], [CLOC]) && 5 flats lcKeySharps = "" lcKeyFlats = "BEADG" case inlist(tcKeyStr, ; [GBMAJ], [ABDOR], [BBPHR], [CLYD], [DBMIX], [EBMIN], [FBLOC]) && 6 flats lcKeySharps = "" lcKeyFlats = "BEADGC" case inlist(tcKeyStr, ; [CBMAJ], [DBDOR], [EBPHR], [FBLYD], [GBMIX], [ABMIN], [BBLOC]) && 7 flats lcKeySharps = "" lcKeyFlats = "BEADGCF" otherwise * NOTE: we are now attempting to handle [APHR], [ALOC], [AAEO], [ALYD] etc. not every flat or sharp key =heythere() wait window timeout 1 [Unknown key: ] + tcKeyStr return lcKeySig && unchanged =fputs(lcOutPut, [Key signature designation unknown or not handled currently]) endcase return tcKeyStr *eof() GetKeySig