Music macros

' These are the macros that manipulate music tab text  as modulo 12 arithmetic
' it is used to move score up and down the scale,and
' can extract particulars of the notes.



Public Const MaxLedger = 12
Public CONST MaxLines = MaxLedger * 6
Public CONST MaxCols = 128

Global Notes(MaxLedger) as Integer
Global LedgerCount as Integer
Global LedgerSequence(MaxLedger) as string
Global ScoreSheet(MaxLines,MaxCols) as String
Global DefaultScore(1 to 6,1 to 6)as String
' This module manipulates arrays of text organized as
'  Western Standard Tabulature  Score
CONST E2 = 32.703
CONST Low = "E2"
CONST C4 = 261.63
CONST Center = "C4"
CONST C4Exp = 4*12 ' three octaves up
CONST PitchRatio = 1.05946
' Get the step sequence for the note tones
CONST scale =  "c d ef g a bc"
Dim GuitarStrings(6) as String

' Then we want the major scales, by triad
CONST Cmajor = "c   e  g "
CONST Gmajor = "g   b  d "
CONST Dmajor = "d   f# a "
CONST Amajor = "a   c# e "
CONST Emajor = "e   g# b "

sub scoreDef(S)
for i  = 1 to 6
for j = 1 to 6
S(i,j) = " "
if i = j then S(i,j) = "q"
next
next
end sub

sub InitScoreModule()
GuitarStrings = Array("E4","B3","G3","D3","A2","E2")

MsgBox("Init Score Module")
end sub
Function ScoreElement(r as Integer,c as Integer, optional x) as string

'ScoreElement = str(r)+str(c)
if c > 16 then msgbox(str(r) + str(c))
 ScoreElement =  ScoreSheet(r,c)
End Function

' Given abdolut note (A10), get the exponent
Function ExpByNote(note as String) as Integer
Dim s as String
s = Lcase(Mid (note,1, 1))
  i = FindIndex(s)

j = Val(Mid (note,2) )
ExpByNote = i-1 + j*12 'whole part  Octave and fractional part by letter
j =  InStr(note,"#")
  if j > 1 then ExpByNote = ExpByNote + 1
end function
Function NoteByExp(e as Integer)  as String
i = e mod 12
s = mid(scale,i+1,1)
i = e mod 12
s = s + str(i)
NoteByExp = s
end function
'Valid formats:  E10# D4# A0
Function FindIndex(note ) as integer
s = Lcase(Mid (note,1, 1))
i=  InStr(scale,s)
s = Mid (note,2)
if InStr(s,"#")  then i = i + 1
FindIndex = i
end function
function MoveScore( ledger,score,delta) as Integer
dim row as integer
dim col as integer
dim measure as integer
dim maxrow as integer
dim maxcol as integer
dim index as integer
dim RowMeasures as Integer
' We allow the score to count measure left to right and top to bottom
' by using the ledger count, so one ledger per score line is mandatory

 'lower boun d is always oner
LedgerCount = ubound(ledger,1)
RowMeasures =ubound(score,1)
RowMeasures = RowMeasures/LedgerCount
maxrow = LedgerCount
maxcol = ubound(score,2)
for row = 0 to LedgerCount-1
Notes(row) = ExpByNote(ledger(row+1,1))
next

for col = 0 to MaxCols-1
for row =  0 to MaxLines-1
ScoreSheet(row,col) = ""
next
Next
for measure = 0 to RowMeasures-1
for col = 0 to maxcol-1  ' Each column
for row = 0 to maxrow-1
index = measure * LedgerCount
if score(index + row+1,col+1) <> 0 then  ' Nasic counts at 1
k = val(mid(score(index + row+1,col+1),2)
k = k + Notes(row)
k = k + delta
i = 0
while k < Notes(i) and i < maxrow
i=i+1
wend
k = k - Notes(i)
t = mid(str(k),2) ' skip the Basic Space
t =  mid(score(index + row+1,col+1),1,1) + t
ScoreSheet(index + i,col) = t
end if
'msgbox(score(row+1,col+1))
Next
Next
Next
MoveScore = 0
end function

' Fills the ledger list with the major triad
Function GetMajor(m as String,Optional x as variant) as String
GetMajor = "none"
LedgerCount=0
select case lcase(m)
case  "c"
GetMajor = Cmajor
case  "g"
GetMajor = Gmajor
case  "d"
GetMajor = Dmajor
case  "a"
GetMajor = Amajor
case  "e"
GetMajor = Emajor
end Select
s2 = Mid (Center,2, 1)
for i = 1 to 8
s = Mid(GetMajor,i,1)
if s <> " " and s <> "#" then
s = s + s2 + Mid(GetMajor,i+1,1)
LedgerSequence(LedgerCount) = s
LedgerCount = LedgerCount+1
end if
next
' j = val(s2)
end Function

Function GetNamedNote(x as String) as Single
Dim ex as Integer
Dim tone  as Single
ex = ExpByNote(x) - C4Exp
tone =  PitchRatio^ex
GetNamedNote = C4 * tone ' all relative to c4 to match the standard
end Function


Function StartZero(Optional x) as Integer
  If  IsMissing(x) or Not IsNumeric(x) Then
StartZero= 0
else
StartZero = x
end if
end Function

Sub ShowHex(val as Long)
REM uses BasicFormulas in OpenOffice Calc
Dim a2, b2, c2 as String
b2 = Hex(val)
MsgBox b2

End Sub