+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Works in Progress (https://qb64phoenix.com/forum/forumdisplay.php?fid=9)
+---- Thread: Learning guitar (/showthread.php?tid=3536)
Learning guitar - OldMoses - 03-15-2025
I've been learning it for 30+ years and still haven't figured it out. Here's a little visual aid I came up with to help with scales, modes, chords, etc. Capo positions can be set with left mouse and upper fretboard masks set with right mouse in the capo track. Center mouse on the fretboard will display notes on staff and keyboard. If sound is chosen it will also sound the tone. I'm sure I've gotten some stuff wrong...ignorance is bliss.
The attachment has the image files that are embedded. This was my first time trying the EMBED feature.
FB4_2.7z (Size: 24.8 KB / Downloads: 117)
Code: (Select All)
'Fretboard IV
'Coding in QB64 Phoenix edition
'by Richard Wessel
$EMBED:'sharp2.png','emsharp'
$EMBED:'flat.png','emflat'
$EMBED:'clef pair.png','emclefp'
$COLOR:32
_TITLE "Fret Board 4.2 <esc> or <Q> to Quit"
TYPE V2
x AS INTEGER
y AS INTEGER
END TYPE
TYPE region
ul AS V2
lr AS V2
END TYPE
TYPE button
hn AS LONG ' button image handle
l AS STRING * 20 ' label
r AS region ' position
c AS _UNSIGNED LONG ' color
h AS INTEGER ' hotkey position
END TYPE
TYPE tone
nt AS STRING * 1 ' natural name
bs AS STRING * 2 ' sharp name
bf AS STRING * 2 ' flat name
ac AS _BYTE ' natural(0) / accidental(-1)
oc AS _BYTE ' octave assignment
sd AS _BYTE ' scale degree
ft AS STRING * 2 ' fret name
c AS _UNSIGNED LONG ' color
hz AS SINGLE ' base cycles
indx AS INTEGER ' array index
END TYPE
'PROGRAM STATE VARIABLES
DIM SHARED AS V2 mous
DIM SHARED AS button bt(59)
DIM SHARED AS tone note(56), tonic
DIM SHARED AS INTEGER frets(5, 25) ' frets( string, fret) value = note(index)
DIM SHARED AS _BYTE masterscale(11), scale(11)
DIM SHARED AS _UNSIGNED LONG defcol, sclcol
DIM SHARED AS SINGLE Hz(11)
DIM SHARED AS LONG togs ' TOGGLES
' 0= Ionian/Major scale
' 1= Dorian scale
' 2= Phrygian scale
' 3= Lydian scale
' 4= Mixolydian scale
' 5= Aeolian/Minor scale
' 6= Locrian scale
' 7= Chord I
' 8= Chord II
' 9= Chord III
' 10= Chord IV
' 11= Chord V
' 12= Chord VI
' 13= Chord VII
' ...
CONST chordset = 21 ' 21= chord clear(0)/chord set(1)
CONST mode_lock = 22 ' 22= mode lock off(0)/on(1)
CONST key_show = 23 ' 23= keyboard hide(0)/keyboard show(1)
CONST col_chg = 24 ' 24= color unchanged(0)/color changed(1)
CONST slnt_snd = 25 ' 25= silent(0)/sound(1)
CONST scale_on = 26 ' 26= scale absent(0)/scale present(1)
CONST picked = 27 ' 27= no notes(0)/picked notes(1)
CONST all_nat = 28 ' 28= all notes(0)/naturals only(1)
CONST hide_show = 29 ' 29= hide notes(0)/show notes(1)
CONST oct_sing = 30 ' 30= single(0)/octave(1)
CONST shrp_flt = 31 ' 31= sharp(0)/flat(1)
CONST TRUE = -1
CONST FALSE = 0
'DISPLAY LIMIT VARIABLES
DIM SHARED scrw%, scrh%, neckdown%, nut%, bridge%, fretmax%, togtop%, togbot%
DIM SHARED capo%, capotop%, capobot%
DIM SHARED frlimit%
'IMAGE HANDLES
DIM SHARED fb&, st&, sttmp&, sharp&, flat&, clefp&
'INITIAL VALUES
'original base size of 1300 x 700
'700/1300=.5385 round this to .55/1.82 and obtain a dynamic screen size for all displays
IF _DESKTOPHEIGHT - 80 * 1.82 > _DESKTOPWIDTH - 80 THEN
scrh% = _DESKTOPHEIGHT - 80
scrw% = scrh% * 1.82
ELSE
scrw% = _DESKTOPWIDTH - 80
scrh% = scrw% * .55
END IF
'DISPLAY LIMIT VALUES
neckdown% = scrh% * .05
togtop% = scrh% * .007
togbot% = togtop% + scrh% * 0.033
capotop% = scrh% * .37
capobot% = scrh% * .4
nut% = scrw% * .15 ' nut position
bridge% = scrw% * .95 ' beyond here is only the bridge
fretmax% = 14 ' maximum # of frets shown
togs = &B11100000000000000000000000000000
defcol = Blue
'SCREENS & IMAGES
fb& = _NEWIMAGE(scrw%, scrh% * .3, 32)
st& = _NEWIMAGE(scrw% * .25, scrh% * .4, 32)
sttmp& = _NEWIMAGE(scrw% * .25, scrh% * .4, 32)
sharp& = _LOADIMAGE(_EMBEDDED$("emsharp"), 32, "memory")
flat& = _LOADIMAGE(_EMBEDDED$("emflat"), 32, "memory")
clefp& = _LOADIMAGE(_EMBEDDED$("emclefp"), 32, "memory")
SCREEN _NEWIMAGE(scrw%, scrh%, 32)
DO: LOOP UNTIL _SCREENEXISTS
_SCREENMOVE 0, 0
RESTORE scale_master
FOR x% = 0 TO 11 ' create master scale array
READ masterscale(x%)
NEXT x%
RESTORE hertz
FOR x% = 0 TO 11 ' create base frequency array
READ Hz(x%)
NEXT x%
ResetScale
SetNote note()
Init_Strings 24
Fret_Board
Make_Buttons
Staff
Stafftmp 0, note(0)
MainLoop
END
' END MAIN MODULE
' DATA SECTION
scale_master:
DATA -1,0,-1,0,-1,-1,0,-1,0,-1,0,-1
hertz:
DATA 32.7,34.65,36.71,38.9,41.2,43.65,46.25,49,51.91,55,58.27,61.74
' SUBROUTINES
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ CONBLOK BUTTON BEVEL
SUB BevelB (xsiz AS INTEGER, ysiz AS INTEGER, col AS _UNSIGNED LONG)
brdr = ABS(_SHR(ysiz, 2) * (ysiz <= xsiz) + _SHR(xsiz, 2) * (ysiz > xsiz)) 'select smaller 1/4 size border axis
rd& = _RED32(col) - 100: gn& = _GREEN32(col) - 100: bl& = _BLUE32(col) - 100
FOR bb = 0 TO brdr
c = c + 100 / brdr
LINE (0 + bb, 0 + bb)-(xsiz - 1 - bb, ysiz - 1 - bb), _RGBA32(rd& + c, gn& + c, bl& + c, _ALPHA(col)), B
NEXT bb
END SUB 'BevelB
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ DISPLAY BUTTON AS <OFF>
SUB ButBlank (b AS INTEGER)
LINE (bt(b).r.ul.x, bt(b).r.ul.y)-(bt(b).r.lr.x, bt(b).r.lr.y), &H7F000000, BF
END SUB 'ButBlank
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ DISPLAY BUTTON
SUB ButPut (b AS INTEGER)
_PUTIMAGE (bt(b).r.ul.x, bt(b).r.ul.y)-(bt(b).r.lr.x, bt(b).r.lr.y), bt(b).hn
END SUB 'ButPut
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ DISPLAY CAPO BLANKING
SUB Capo_Track
fw% = Fret_Wide%
tps% = capotop% + _SHR(capobot% - capotop%, 1) - 8
_PRINTSTRING (4, tps%), "Capo Position"
FOR fr% = 0 TO fretmax%
x% = nut% + fw% * fr%
LINE (x% - fw%, capotop%)-(x%, capobot%), , B
IF fr% = capo% THEN _PRINTSTRING (x% - (fw% / 2), tps%), _TRIM$(STR$(fr%))
NEXT fr%
IF capo% THEN ' fretboard blanking
LINE (nut%, neckdown%)-(nut% + fw% * capo%, neckdown% + _HEIGHT(fb&)), &H7F000000, BF
END IF
END SUB 'Capo_Track
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ DISPLAY UPPER LIMIT BLANKING
SUB Limit_Track
IF frlimit% THEN
LINE (nut% + Fret_Wide% * frlimit%, neckdown%)-(bridge%, neckdown% + _HEIGHT(fb&)), &H7F000000, BF
END IF
END SUB 'Limit_Track
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ CHORD INVERSE COLOR
SUB Chord (d AS INTEGER)
chrd& = Negative~&(sclcol) ' negative inversion of scale color
ch% = d
FOR triad% = 1 TO 3 ' degree of triad
FOR n% = 0 TO 56
IF note(n%).sd = ch% THEN ' if note scale degree equals chord degree
note(n%).c = chrd& ' apply negative contrast color
END IF
NEXT n%
ch% = ch% + 2 ' advance to next chord degree
IF ch% > 7 THEN ch% = ch% - 7 ' scale wrap around
NEXT triad%
END SUB 'Chord
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ CLEAR MOUSEBUTTON BUFFER
SUB Clear_MB (var AS INTEGER)
DO UNTIL NOT _MOUSEBUTTON(var)
_LIMIT 30
WHILE _MOUSEINPUT: WEND
LOOP
END SUB 'Clear_MB
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ CREATE CONTROL BLOCK
SUB CtrlBlk (b AS button)
xsiz% = b.r.lr.x - b.r.ul.x + 1
ysiz% = b.r.lr.y - b.r.ul.y + 1
dst& = _DEST ' save calling destination
b.hn = _NEWIMAGE(xsiz%, ysiz%, 32)
_DEST b.hn
COLOR , b.c
CLS
BevelB xsiz%, ysiz%, b.c
_PRINTMODE _KEEPBACKGROUND
x% = LEN(_TRIM$(b.l))
sx = xsiz% / 2 - x% * 4: sy = ysiz% / 2 - 8
FOR p% = 1 TO x% ' iterate through label characters
COLOR -4294901760 * (p% = b.h) - 4278190080 * (p% <> b.h) '&HFFFF0000 &HFF000000
IF b.c = &HFFC80000 THEN COLOR &HFFFFFFFF
_PRINTSTRING (sx + (p% - 1) * 8, sy), MID$(_TRIM$(b.l), p%, 1)
NEXT p%
_DEST dst&
END SUB 'CtrlBlk
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ SET DEFAULT COLORS
SUB Default_Color (x%)
SELECT CASE x% - 38
CASE 0: bt(x%).c = Blue
CASE 1: bt(x%).c = Green
CASE 2: bt(x%).c = Red
CASE 3: bt(x%).c = Purple
CASE 4: bt(x%).c = Aqua
CASE 5: bt(x%).c = Orange
CASE 6: bt(x%).c = Yellow
CASE 7: bt(x%).c = Coral
CASE 8: bt(x%).c = Cerulean
CASE 9: bt(x%).c = Lime
CASE 10: bt(x%).c = Teal
CASE 11: bt(x%).c = Timberwolf
END SELECT
END SUB 'Default_Color
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ PIE CHART DIVIDE SPOTS
SUB Divisions (x%, y%, r%, div%, col&)
IF div% = 1 THEN EXIT SUB
div! = _PI(2) / div% ' radians per division
DO
ang = ang + div!
LINE (x%, y%)-(x% + COS(ang) * r%, y% + SIN(ang) * r%), Negative~&(col&) 'White
LOOP UNTIL ang >= _PI(2)
END SUB 'Divisions
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ SET AND DISPLAY FRETBOARD EDGE DOTS
SUB DotFret
fw% = Fret_Wide%
fw1% = _SHR(fw%, 2) ' 1/4 fret width
fw2% = _SHR(fw%, 1) ' 1/2 fret width
fw3% = fw1% * 3 ' 3/4 fret width
y% = neckdown% + _HEIGHT(fb&) + ((capotop% - (neckdown% + _HEIGHT(fb&))) / 2)
r% = .1875 * (capotop% - (neckdown% + _HEIGHT(fb&)))
FOR x% = 3 TO fretmax%
SELECT CASE x%
CASE 3, 5, 7, 9, 15, 17, 19, 21 ' single dot positions
FCirc nut% + x% * fw% - fw2%, y%, r%, White
CASE 12, 24 ' double dot positions
FCirc nut% + x% * fw% - fw1%, y%, r%, White
FCirc nut% + x% * fw% - fw3%, y%, r%, White
END SELECT
NEXT x%
END SUB 'DotFret
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ INITIAL STRING NOTE VALUES
SUB Init_Strings (fm AS INTEGER)
n% = 33 ' Initialize strings to standard tuning
FOR s% = 0 TO 5 ' Strings 0 through 5 (eBGDAE)
n% = n% + 4 * (s% = 2) + 5 * (s% <> 2) ' 4 frets on G (maj 3rd), 5 frets all others (perf 4th)
frets(s%, 25) = n% ' base note of standard tuning
frets(s%, 0) = frets(s%, 25) ' open note of string s%
FOR f% = 1 TO fm
frets(s%, f%) = frets(s%, 0) + f% ' populate fret notes
NEXT f%
NEXT s%
END SUB 'Init_Strings
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ DRAW FILLED CIRCLES
SUB FCirc (CX AS LONG, CY AS LONG, RR AS LONG, C AS _UNSIGNED LONG) 'by Steve McNeill
DIM AS LONG R, RError, X, Y
R = ABS(RR) ' radius value along positive x
RError = -R ' opposite side of circle? negative x
X = R ' point along positive x position
Y = 0 ' starting at the equator
IF R = 0 THEN PSET (CX, CY), C: EXIT SUB ' zero radius is point, not circle
LINE (CX - X, CY)-(CX + X, CY), C, BF ' draw equatorial line
WHILE X > Y
RError = RError + Y * 2 + 1
IF RError >= 0 THEN
IF X <> Y + 1 THEN
LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF ' draw line above equator
LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF ' draw line below equator
END IF
X = X - 1
RError = RError - X * 2
END IF
Y = Y + 1
LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF ' draw line north latitudes
LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF ' draw line south latitudes
WEND
END SUB 'FCirc
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ CREATE FRETBOARD IMAGE
SUB Fret_Board
fr_rng% = Fret_Wide% ' fret range
h% = _HEIGHT(fb&)
_DEST fb&
CLS
LINE (nut%, 0)-(bridge%, h%), RawUmber, BF ' fretboard
LINE (nut% - 5, 0)-(nut% - 1, h%), Beige, BF ' nut
FOR fr% = 1 TO fretmax% ' frets
fr_ps% = nut% + fr_rng% * fr%
LINE (fr_ps%, 0)-(fr_ps% + 3, h%), PaleGoldenRod, BF
LINE (fr_ps% - 1, 0)-(fr_ps% - 1, h%), Black, BF
SELECT CASE fr% ' fretboard spots
CASE 3, 5, 7, 9, 15, 17, 19, 21
FCirc fr_ps% - _SHR(fr_rng%, 1), h% / 2, .05 * h%, BlueBell
CASE 12, 24
FCirc fr_ps% - _SHR(fr_rng%, 1), h% * (1 / 3), .05 * h%, BlueBell
FCirc fr_ps% - _SHR(fr_rng%, 1), h% * (2 / 3), .05 * h%, BlueBell
END SELECT
NEXT fr%
st_rng% = h% / 6
FOR st% = 0 TO 5 ' strings overlay
st_ps% = st_rng% * st% + (st_rng% / 2)
LINE (nut%, st_ps%)-(bridge%, st_ps% + (_CEIL((st% + 1) / 2))), Gold, BF
NEXT st%
_DEST 0
END SUB 'Fret_Board
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ WIDTH OF FRETS
FUNCTION Fret_Wide%
Fret_Wide% = (bridge% - nut%) / fretmax%
END FUNCTION 'Fret_Wide
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ FIT IMAGE TO DEFINED SPACE
SUB Image_Resize (xpos AS INTEGER, ypos AS INTEGER, xlim AS INTEGER, ylim AS INTEGER, i AS LONG, d AS LONG, xj AS STRING, yj AS STRING)
DIM AS INTEGER xs, ys, xp, yp, xl, yl ' ready for OPTION EXPLICIT programs
xp = xpos: yp = ypos: xl = xlim: yl = ylim ' isolate sent parameters from any changes
DIM AS SINGLE rt, xrt, yrt
xrt = (xl - xp) / _WIDTH(i) ' width of area divided by width of image
yrt = (yl - yp) / _HEIGHT(i) ' height of area divided by height of image
rt = -xrt * (xrt < yrt) - yrt * (yrt <= xrt) ' pick the smaller of the two ratios to fit area
xs = _WIDTH(i) * rt ' final image size ratio in x
ys = _HEIGHT(i) * rt ' final image size ratio in y
xp = -xp * (xj = "l") - (_SHR(xl - xp, 1) + xp - _SHR(xs, 1)) * (xj = "c") - (xl - xs) * (xj = "r")
xl = xp + xs
yp = -yp * (yj = "u") - (_SHR(yl - yp, 1) + yp - _SHR(ys, 1)) * (yj = "c") - (yl - ys) * (yj = "d")
yl = yp + ys
_PUTIMAGE (xp, yp)-(xl, yl), i, d
END SUB 'Image_Resize
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ BOOLEAN REGION DETECTION 1D
FUNCTION InRange% (var%, ll%, ul%) 'll% & ul% are order insensitive
InRange% = -((var% >= (-ll% * (ll% <= ul%) - ul% * (ll% > ul%))) * (var% <= (-ul% * (ll% <= ul%) - ll% * (ll% > ul%)))) 'in range? T/F
END FUNCTION 'InRange%
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ BOOLEAN REGION DETECTION 2D
FUNCTION InRegion% (p AS V2, r AS region)
InRegion% = -(InRange%(p.x, r.ul.x, r.lr.x) * InRange%(p.y, r.ul.y, r.lr.y)) 'in region? T/F
END FUNCTION 'InRegion%
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ DISPLAY SCALE INTERVALS
SUB Intervals
DIM I$25(12), D$3(8)
I$25(0) = " root/tonic/unison": I$25(1) = " minor 2nd/semitone"
I$25(2) = " major 2nd/tone": I$25(3) = " minor 3rd"
I$25(4) = " major 3rd": I$25(5) = " perfect 4th"
I$25(6) = " aug 4/dim 5/tritone": I$25(7) = " perfect 5th/dominant"
I$25(8) = " minor 6th": I$25(9) = " major 6th"
I$25(10) = " minor 7th": I$25(11) = " major 7th": I$25(12) = " octave"
D$3(1) = "I": D$3(2) = "II": D$3(3) = "III": D$3(4) = "IV"
D$3(5) = "V": D$3(6) = "VI": D$3(7) = "VII": D$3(8) = "8'v"
hi& = sclcol
lo& = Gray
x% = bt(50).r.lr.x + 5
y% = bt(27).r.ul.y + 29
d% = 0
_PRINTSTRING (x%, y%), "LIST OF INTERVALS"
FOR l% = 0 TO 12 ' intervals unison thru octave
COLOR lo&
IF _READBIT(togs, scale_on) THEN ' if scale chosen
IF l% = 12 THEN ' trap scale subscript error and set for octave
COLOR hi&: dp% = TRUE
d% = 8
ELSE
IF scale(l%) THEN
COLOR hi&: dp% = TRUE
d% = d% + 1
END IF
END IF
END IF
y% = y% + 16
_PRINTSTRING (x%, y%), I$25(l%) ' print interval name
_PRINTSTRING (x%, y%), _TRIM$(STR$(l%)) ' print interval number
IF dp% THEN
_PRINTSTRING (x% + 200, y%), "- " + D$3(d%) ' print scale degree
dp% = FALSE ' clear degree print
END IF
NEXT l%
COLOR White
END SUB 'Intervals
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ DRAW KEYBOARD AND SHOW CHOSEN NOTES
SUB KeyBoard (kh%)
DIM kb&
kb& = _NEWIMAGE(680, 100, 32) ' 34 white keys x 20
_DEST kb&
CLS , White
FOR x% = 0 TO 56
IF note(x%).ac THEN
IF x% = kh% THEN
LINE (p% * 20 - 6, 0)-(p% * 20 + 6, 60), Red, BF 'highlight black key
LINE (p% * 20 - 6, 0)-(p% * 20 + 6, 60), Black, B
LINE (p% * 20 - 5, 1)-(p% * 20 + 5, 59), Black, B
ELSE
LINE (p% * 20 - 6, 0)-(p% * 20 + 6, 60), Black, BF 'black keys 16x60
END IF
IF note(x%).sd THEN
FCirc p% * 20, 40, 5, note(x%).c
CIRCLE (p% * 20, 40), 5, White
IF note(x%).sd = 1 THEN ' Tonic note
FCirc p% * 20, 40, 2, White ' Red
END IF
END IF
ELSE
IF x% = kh% THEN
LINE (p% * 20, 0)-(p% * 20 + 20, 100), &H3FFF0000, BF 'highlight white key
ELSE
LINE (p% * 20, 0)-(p% * 20 + 20, 100), Black, B
END IF
IF x% = 12 THEN ' spot middle C
FCirc p% * 20 + 10, 97, 2, Black
END IF
IF note(x%).sd THEN
FCirc p% * 20 + 10, 80, 5, note(x%).c
IF note(x%).sd = 1 THEN ' Tonic note
FCirc p% * 20 + 10, 80, 2, White 'Red
END IF
END IF
p% = p% + 1
END IF
NEXT x%
_DEST 0
_PUTIMAGE (_WIDTH(0) - _WIDTH(kb&), scrh% * .41), kb&
_FREEIMAGE kb&
END SUB 'KeyBoard
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ MAIN PROGRAM INPUT/DISPLAY JUNCTION
SUB MainLoop
in% = TRUE: high% = 57 ' loop initial states
DO ' DISPLAY LOOP
DO ' INPUT LOOP
'key input
IF _KEYDOWN(8) THEN ' backspace' clear all
Note_Zero
_DELAY .2: in% = TRUE
END IF
IF _KEYDOWN(65) OR _KEYDOWN(97) THEN
togs = _TOGGLEBIT(togs, all_nat) ' a=all/naturals only
_DELAY .2: in% = TRUE
END IF
IF _KEYDOWN(66) OR _KEYDOWN(98) THEN
togs = _TOGGLEBIT(togs, shrp_flt) ' b=flat/sharp
_DELAY .2: in% = TRUE
END IF
IF _KEYDOWN(72) OR _KEYDOWN(104) THEN
togs = _TOGGLEBIT(togs, hide_show) ' h=hide/show notes
_DELAY .2: in% = TRUE
END IF
IF _KEYDOWN(75) OR _KEYDOWN(107) THEN
togs = _TOGGLEBIT(togs, key_show) ' k=hide/show keyboard
_DELAY .2: in% = TRUE
END IF
IF _KEYDOWN(83) OR _KEYDOWN(115) THEN
togs = _TOGGLEBIT(togs, slnt_snd) ' s=silent/sound
_DELAY .2: in% = TRUE
END IF
IF _KEYDOWN(81) OR _KEYDOWN(113) OR _KEYDOWN(27) THEN SYSTEM 'Quit
IF _KEYDOWN(19712) THEN ' forward arrow= increase fretboard
fretmax% = fretmax% - (fretmax% < 24)
Fret_Board
_DELAY .2
in% = TRUE
END IF
IF _KEYDOWN(19200) THEN ' back arrow= reduce fretboard
fretmax% = fretmax% + (fretmax% > 14)
Fret_Board
_DELAY .2: in% = TRUE
END IF
'mouse input
ms = MBS%
IF ms AND 1 THEN ' left mouse button press
Clear_MB 1
MB_Left mous
singnt% = 0: ntchs% = 0
in% = TRUE
END IF
IF ms AND 2 THEN ' right mouse button press
Clear_MB 2
MB_Right mous
singnt% = 0: ntchs% = 0
in% = TRUE
END IF
IF ms AND 4 THEN ' center/mousewheel button press on fretboard
IF InRegion%(mous, bt(19).r) THEN ' if on fretboard
st% = INT((mous.y - neckdown%) / (_HEIGHT(fb&) / 6)) 'string calc
fr% = INT((mous.x - nut%) / Fret_Wide%) + 1 'fret calc
IF fr% = 0 THEN a% = capo% ELSE a% = 0
high% = frets(st%, fr%) + a%
singnt% = TRUE: ntchs% = frets(st%, fr%) + a%
in% = TRUE
IF _READBIT(togs, slnt_snd) THEN
SOUND note(frets(st%, fr%) + a%).hz, 18
END IF
END IF
Clear_MB 3
END IF
_LIMIT 30
LOOP UNTIL in% ' END: INPUT LOOP
in% = FALSE
CLS
'image refresh
_PUTIMAGE (0, neckdown%), fb&, 0 ' OVERLAY FRETBOARD
_PRINTSTRING (16, neckdown% - 20), "Tuners"
FOR x% = 0 TO 51 ' place buttons and toggles
IF x% > 17 AND x% < 21 THEN _CONTINUE ' skip capo track, fretboard & circle of fifths
ButPut x%
IF x% < 18 AND x% MOD 3 = 1 THEN ' if center tuner
IF frets(x% \ 3, 0) = frets(x% \ 3, 25) THEN
ButBlank x% ' blank if default tuned
ELSE
IF frets(x% \ 3, 0) > frets(x% \ 3, 25) THEN
RegionArrow bt(x%).r, "u", "half", &H6FFF0000 'tune arrow
ELSE
RegionArrow bt(x%).r, "d", "half", &H6FFF0000 'tune arrow
END IF
END IF
END IF
SELECT CASE x%
CASE 21 TO 27 ' Mode toggles
IF NOT _READBIT(togs, x% - 21) THEN ButBlank x%
IF _READBIT(togs, mode_lock) AND _READBIT(togs, x% - 21) THEN
RegionRing bt(x%).r, Red, 3
END IF
CASE 28, 29 ' octave/single toggle
IF _READBIT(togs, oct_sing) THEN blk% = 29 ELSE blk% = 28
IF x% = blk% THEN ButBlank x%
CASE 30, 31 ' all/natural toggle
IF _READBIT(togs, all_nat) THEN blk% = 30 ELSE blk% = 31
IF x% = blk% THEN ButBlank x%
CASE 32, 33 ' show/hide notes toggle
IF _READBIT(togs, hide_show) THEN blk% = 33 ELSE blk% = 32
IF x% = blk% THEN ButBlank x%
CASE 34, 35
IF _READBIT(togs, shrp_flt) THEN blk% = 34 ELSE blk% = 35
IF x% = blk% THEN ButBlank x%
CASE 36, 37
IF _READBIT(togs, slnt_snd) THEN blk% = 36 ELSE blk% = 37
IF x% = blk% THEN ButBlank x%
CASE 38 TO 49
IF defcol = bt(x%).c THEN ' white border active color
'RegionRing bt(x%).r, White, 6
RegionRing bt(x%).r, Negative~&(bt(x%).c), 6
END IF
CASE 50
IF NOT _READBIT(togs, col_chg) THEN ButBlank x%
CASE 51
IF NOT _READBIT(togs, key_show) THEN ButBlank x%
END SELECT
NEXT x%
SELECT EVERYCASE fretmax%
CASE 14 TO 23
RegionArrow bt(52).r, "r", "half", &H9FFF0000
CASE 15 TO 24
RegionArrow bt(52).r, "l", "half", &H9FFF0000
END SELECT
FOR x% = 53 TO 59
ButPut x%
IF NOT _READBIT(togs, x% - 46) THEN ButBlank x%
NEXT x%
'String_Notes
String_NotesII
Stafftmp singnt%, note(ntchs%) '
_PUTIMAGE (scrw% * .75, scrh% * .6)-(scrw% - 1, scrh% - 1), sttmp& '
DotFret
Capo_Track
Limit_Track
Circle_of_Fifth
Intervals
NameChords
IF _READBIT(togs, key_show) THEN KeyBoard high%: high% = 57 '
_PRINTSTRING (0, _HEIGHT(0) - 64), "clockwise:"
_PRINTSTRING (0, _HEIGHT(0) - 48), "Father Charles Goes Down And Ends Battle"
_PRINTSTRING (0, _HEIGHT(0) - 32), "counter clockwise:"
_PRINTSTRING (0, _HEIGHT(0) - 16), "Battle Ends And Down Goes Charles Father"
'_PRINTSTRING (0, 0), aspect$
_DISPLAY
LOOP UNTIL done% ' END: DISPLAY LOOP
END SUB 'MainLoop
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ CREATE CONTROL BUTTONS & REGIONS
SUB Make_Buttons
sz% = ((_HEIGHT(fb&) - 1) / 6) * .75 ' Tuners
FOR y% = 0 TO 5 ' iterating string tiers
yp% = neckdown% + y% * ((_HEIGHT(fb&) - 1) / 6) + sz% / 3
FOR x% = 0 TO 2
xp% = sz% / 2 + x% * sz% * 1.25
b% = x% + y% * 3
bt(b%).l = _TRIM$(MID$("-|+", x% + 1, 1))
bt(b%).r.ul.x = xp%
bt(b%).r.ul.y = yp%
bt(b%).r.lr.x = xp% + sz%
bt(b%).r.lr.y = yp% + sz%
bt(b%).c = &HFF00FF00
bt(b%).h = 0
CtrlBlk bt(b%)
NEXT x%
NEXT y%
bt(18).r.ul.x = nut% - Fret_Wide% '-------------------------capo track region
bt(18).r.ul.y = capotop%
bt(18).r.lr.x = bridge%
bt(18).r.lr.y = capobot%
bt(19).r.ul.x = bt(18).r.ul.x '-----------------------------fretboard region
bt(19).r.ul.y = neckdown%
bt(19).r.lr.x = bridge%
bt(19).r.lr.y = neckdown% + _HEIGHT(fb&) - 1
bt(20).r.ul.x = 0 '-----------------------------------------circle of fifths region
bt(20).r.ul.y = scrh% * .42
bt(20).r.lr.x = _HEIGHT(0) - scrh% * .5
bt(20).r.lr.y = bt(20).r.ul.y + bt(20).r.lr.x
FOR x% = 21 TO 27 '-----------------------------------------SCALES
bt(x%).r.ul.x = bt(20).r.lr.x + 1
bt(x%).r.ul.y = bt(20).r.ul.y + (24 * (x% - 21))
bt(x%).r.lr.x = bt(x%).r.ul.x + 128
bt(x%).r.lr.y = bt(x%).r.ul.y + 24
bt(x%).c = &HFF00FF00
SELECT CASE x%
CASE 21: bt(x%).l = "Ionian/Major"
CASE 22: bt(x%).l = "Dorian"
CASE 23: bt(x%).l = "Phrygian"
CASE 24: bt(x%).l = "Lydian"
CASE 25: bt(x%).l = "Mixolydian"
CASE 26: bt(x%).l = "Aeolian/Minor"
CASE 27: bt(x%).l = "Locrian"
END SELECT
CtrlBlk bt(x%)
NEXT x%
FOR x% = 28 TO 37 '-----------------------------------------TOP TOGGLES
IF x% = 28 THEN
ul% = nut%
ELSE
ul% = bt(x% - 1).r.lr.x - (x% MOD 2 <> 0) - (scrw% * .02) * (x% MOD 2 = 0)
END IF
bt(x%).r.ul.x = ul%
bt(x%).r.ul.y = togtop%
bt(x%).r.lr.x = bt(x%).r.ul.x + 63
bt(x%).r.lr.y = togbot% 'bt(x%).r.ul.y + 23
SELECT CASE x%
CASE 28: bt(x%).l = "Octave"
CASE 29: bt(x%).l = "Single"
CASE 30: bt(x%).l = "All": bt(x%).h = 1
CASE 31: bt(x%).l = "Natural": bt(x%).h = 2
CASE 32: bt(x%).l = "Show": bt(x%).h = 2
CASE 33: bt(x%).l = "Hide": bt(x%).h = 1
CASE 34: bt(x%).l = "Sharp"
CASE 35: bt(x%).l = "Flat"
CASE 36: bt(x%).l = "Silent": bt(x%).h = 1
CASE 37: bt(x%).l = "Sound": bt(x%).h = 1
END SELECT
bt(x%).c = &HFF00FF00
CtrlBlk bt(x%)
NEXT x%
IF _FILEEXISTS("notecolor.ini") THEN
f& = FREEFILE
OPEN "notecolor.ini" FOR BINARY AS f&
colorfile% = TRUE
ELSE
colorfile% = FALSE
END IF
FOR x% = 38 TO 49 '-----------------------------------------Twelve 42 x 42 color buttons
ho% = (x% - 38) MOD 3
vo% = (x% - 38) \ 3
bt(x%).r.ul.x = bt(20).r.lr.x + 1 + (42 * ho%)
bt(x%).r.ul.y = bt(27).r.ul.y + 29 + (42 * vo%)
bt(x%).r.lr.x = bt(x%).r.ul.x + 42
bt(x%).r.lr.y = bt(x%).r.ul.y + 42
IF colorfile% THEN
GET f&, , bt(x%).c
ELSE
Default_Color x%
END IF
CtrlBlk bt(x%)
NEXT x%
CLOSE f&
bt(50).r.ul.x = bt(20).r.lr.x + 1 ' color save
bt(50).r.ul.y = bt(49).r.lr.y + 5
bt(50).r.lr.x = bt(50).r.ul.x + 128
bt(50).r.lr.y = bt(50).r.ul.y + 36
bt(50).c = &HFF00FF00
bt(50).l = "Save colors"
CtrlBlk bt(50)
bt(51).r.ul.x = bt(37).r.lr.x + (scrw% * .02) '-------------Keyboard
bt(51).r.ul.y = togtop% 'bt(37).r.ul.y
bt(51).r.lr.x = bt(51).r.ul.x + 96
bt(51).r.lr.y = togbot% 'bt(51).r.ul.y + 23
bt(51).c = &HFF00FF00
bt(51).h = 1
bt(51).l = "Keyboard"
CtrlBlk bt(51)
bt(52).r.ul.x = scrw% * .96 '-------------------------------Fret Size Control
bt(52).r.ul.y = neckdown%
bt(52).r.lr.x = scrw% * .99
bt(52).r.lr.y = neckdown% + _HEIGHT(fb&)
FOR x% = 53 TO 59 '-----------------------------------------Chord controls
bt(x%).r.ul.x = bt(x% - 32).r.lr.x + 5
bt(x%).r.ul.y = bt(x% - 32).r.ul.y
bt(x%).r.lr.x = bt(x%).r.ul.x + 96
bt(x%).r.lr.y = bt(x%).r.ul.y + 24
bt(x%).c = &HFF00FF00
SELECT CASE x%
CASE 53: bt(x%).l = "I"
CASE 54: bt(x%).l = "II"
CASE 55: bt(x%).l = "III"
CASE 56: bt(x%).l = "IV"
CASE 57: bt(x%).l = "V"
CASE 58: bt(x%).l = "VI"
CASE 59: bt(x%).l = "VII"
END SELECT
CtrlBlk bt(x%)
NEXT x%
_DEST 0
END SUB 'Make_Buttons
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ LEFT MOUSE BUTTON OPS
SUB MB_Left (ps AS V2)
FOR x% = 0 TO 59
IF InRegion%(ps, bt(x%).r) THEN
valid% = TRUE: EXIT FOR
END IF
NEXT x%
IF NOT valid% THEN EXIT SUB
SELECT CASE x%
CASE 0 TO 17 ' TUNER REGIONS
IF x% MOD 3 = 0 THEN ' Detune
frets(INT(x% / 3), 0) = frets(INT(x% / 3), 0) + (frets(INT(x% / 3), 0) > 0)
ELSEIF x% MOD 3 = 1 THEN ' Base tuning
frets(INT(x% / 3), 0) = frets(INT(x% / 3), 25)
ELSEIF x% MOD 3 = 2 THEN ' Uptune
frets(INT(x% / 3), 0) = frets(INT(x% / 3), 0) - (frets(INT(x% / 3), 24) < 56)
END IF
FOR s% = 0 TO 5 ' re-tune strings
FOR f% = 1 TO 24
frets(s%, f%) = frets(s%, 0) + f%
NEXT f%
NEXT s%
CASE 18
capo% = _CEIL((ps.x - nut%) / Fret_Wide%)
IF capo% < 0 THEN capo% = 0
CASE 19 ' FRETBOARD REGION
st% = INT((ps.y - neckdown%) / (_HEIGHT(fb&) / 6)) 'string calc
fr% = INT((ps.x - nut%) / Fret_Wide%) + 1 ' fret calc
SearchNote -1, note(frets(st%, fr%))
CASE 20 ' CIRCLE OF FIFTHS REGION
DIM AS V2 cen, clk
DIM k(11) AS tone
SetNote k()
cen.x = _SHR(bt(20).r.lr.x, 1) ' center of circle of fifths
cen.y = bt(20).r.ul.y + cen.x
clk = mous: R2_Add clk, cen, -1 ' clk relative to circle center
IF R2_Mag!(clk) < cen.x * .3 THEN ' within clear all circle
Note_Zero
ELSE
IF R2_Mag(clk) > cen.x * .7 AND R2_Mag(clk) < cen.x * .9 THEN 'within note ring
IF _READBIT(togs, scale_on) THEN Note_Zero 'clear all for new scale
ang% = _R2D(_ATAN2(clk.y, clk.x) - .261799) 'get angle of mouse click _PI / 12 = .261799
IF SGN(ang%) < 0 THEN
ang% = INT(ABS(ang%) / 30)
ELSE
ang% = INT((180 + (180 - ang%)) / 30)
END IF
in% = 9
DO UNTIL ang% = 0
in% = Pfifth%(in%, 5)
ang% = ang% - 1
LOOP
togs = _SETBIT(togs, scale_on) ' set scale mode
FOR x% = 0 TO 6 ' check all modal states
t% = t% + _READBIT(togs, x%)
NEXT x%
IF t% = 0 THEN togs = _SETBIT(togs, 0) ' if no state set default to Ionian/Major
tonic = k(in%) ' set tonic ID
Signature in% ' adjust sharp/flat to appropriate key
Scale_Run ' construct scale note pointers
END IF
END IF
CASE 21 TO 27 ' SCALE MODES
ResetScale ' set back to Ionian scale
Note_Zero ' clear all note selections
FOR b% = 21 TO 27
IF b% = x% THEN
togs = _TOGGLEBIT(togs, b% - 21) ' toggle selected bit on/off
ELSE
togs = _RESETBIT(togs, b% - 21) ' clear all non-selected bits
END IF
NEXT b%
SELECT CASE x% ' determine scale rotation factor - use shortest
CASE 21: rotar% = 0 ' ionian 0
CASE 22: rotar% = -2 ' dorian -2 10
CASE 23: rotar% = -4 ' phrygian -4 8
CASE 24: rotar% = -5 ' lydian -5 7
CASE 25: rotar% = 5 ' mixolydian -7 5
CASE 26: rotar% = 3 ' aeolian -9 3
CASE 27: rotar% = 1 ' locrian -11 1
END SELECT
RotArrayM scale(), rotar% ' rotate to mode from Ionian
CASE 28, 29 ' SINGLE/OCTAVE TOGGLE
togs = _TOGGLEBIT(togs, oct_sing)
CASE 30, 31
togs = _TOGGLEBIT(togs, all_nat)
CASE 32, 33
togs = _TOGGLEBIT(togs, hide_show)
CASE 34, 35
togs = _TOGGLEBIT(togs, shrp_flt)
CASE 36, 37
togs = _TOGGLEBIT(togs, slnt_snd)
CASE 38 TO 49
defcol = bt(x%).c ' default color
CASE 50
IF _READBIT(togs, col_chg) THEN
IF _FILEEXISTS("notecolor.ini") THEN
KILL "notecolor.ini"
END IF
f& = FREEFILE
OPEN "notecolor.ini" FOR BINARY AS f&
FOR c% = 38 TO 49
PUT f&, , bt(c%).c
NEXT c%
CLOSE f&
togs = _RESETBIT(togs, col_chg)
END IF
CASE 51
togs = _TOGGLEBIT(togs, key_show)
CASE 52
IF ps.x < bt(52).r.ul.x + _SHR(bt(52).r.lr.x - bt(52).r.ul.x, 1) THEN
fretmax% = fretmax% + (fretmax% > 14)
Fret_Board
ELSE
fretmax% = fretmax% - (fretmax% < 24)
Fret_Board
END IF
CASE 53 TO 59 ' Chord buttons
FOR t% = 7 TO 13
togs = _RESETBIT(togs, t%)
NEXT t%
IF _READBIT(togs, scale_on) THEN
UnChord
'try a toggle on/off modification
togs = _SETBIT(togs, chordset)
togs = _SETBIT(togs, x% - 46)
Chord x% - 52
END IF
CASE ELSE
END SELECT
END SUB 'MB_Left
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ RIGHT BUTTON MOUSE OPS
SUB MB_Right (ps AS V2)
FOR x% = 0 TO 50
IF InRegion%(ps, bt(x%).r) THEN
valid% = TRUE: EXIT FOR
END IF
NEXT x%
IF NOT valid% THEN EXIT SUB
SELECT CASE x%
CASE 18
frlimit% = _CEIL((ps.x - nut%) / Fret_Wide%) - 1
IF frlimit% > fretmax% THEN frlimit% = 0
IF frlimit% < 0 THEN frlimit% = 0
CASE 19
st% = INT((ps.y - neckdown%) / (_HEIGHT(fb&) / 6)) 'string calc
fr% = INT((ps.x - nut%) / Fret_Wide%) + 1 ' fret calc
IF fr% = 0 THEN a% = capo% ELSE a% = 0 ' fret 0 alteration
SearchNote 0, note(frets(st%, fr%))
pk% = FALSE
FOR srch% = 0 TO 56
IF note(srch%).sd <> 0 THEN pk% = TRUE
NEXT srch%
IF NOT pk% THEN
togs = _RESETBIT(togs, scale_on)
togs = _RESETBIT(togs, picked)
END IF
CASE 21 TO 27 ' Mode buttons
'right click to lock in mode
togs = _TOGGLEBIT(togs, mode_lock)
CASE 38 TO 49 ' Color buttons
ncolor& = _COLORCHOOSERDIALOG("", 0)
IF ncolor& <> 0 THEN bt(x%).c = ncolor&
_DEST bt(x%).hn
CLS
CtrlBlk bt(x%)
togs = _SETBIT(togs, col_chg)
_DEST 0
CASE 50 'right click on save button to restore default colors
m& = _MESSAGEBOX("Restore Default Colors", "Are you sure you wish to restore defualts?", "okcancel", "warning", 0)
IF m& THEN
FOR x% = 38 TO 49 ' Twelve 42 x 42 color buttons
Default_Color x%
_DEST bt(x%).hn
CLS
CtrlBlk bt(x%)
NEXT x%
_DEST 0
togs = _SETBIT(togs, col_chg)
END IF
END SELECT
END SUB 'MB_Right
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ MOUSE BUTTON STATUS
FUNCTION MBS% 'Mouse Button Status by Steve McNeill
STATIC StartTimer AS _FLOAT
STATIC ButtonDown AS INTEGER
CONST ClickLimit## = 0.2 'Less than 1/4th of a second to down, up a key to count as a CLICK.
' Down longer counts as a HOLD event.
SHARED Mouse_StartX, Mouse_StartY, Mouse_EndX, Mouse_EndY
WHILE _MOUSEINPUT 'Remark out this block, if mouse main input/clear is going to be handled manually in main program.
SELECT CASE SGN(_MOUSEWHEEL)
CASE 1: tempMBS = tempMBS OR 512
CASE -1: tempMBS = tempMBS OR 1024
END SELECT
WEND
mous.x = _MOUSEX
mous.y = _MOUSEY
IF _MOUSEBUTTON(1) THEN tempMBS = tempMBS OR 1
IF _MOUSEBUTTON(2) THEN tempMBS = tempMBS OR 2
IF _MOUSEBUTTON(3) THEN tempMBS = tempMBS OR 4
IF StartTimer = 0 THEN
IF _MOUSEBUTTON(1) THEN 'If a button is pressed, start the timer to see what it does (click or hold)
ButtonDown = 1: StartTimer = TIMER(0.01)
Mouse_StartX = _MOUSEX: Mouse_StartY = _MOUSEY
ELSEIF _MOUSEBUTTON(2) THEN
ButtonDown = 2: StartTimer = TIMER(0.01)
Mouse_StartX = _MOUSEX: Mouse_StartY = _MOUSEY
ELSEIF _MOUSEBUTTON(3) THEN
ButtonDown = 3: StartTimer = TIMER(0.01)
Mouse_StartX = _MOUSEX: Mouse_StartY = _MOUSEY
END IF
ELSE
BD = ButtonDown MOD 3
IF BD = 0 THEN BD = 3
IF TIMER(0.01) - StartTimer <= ClickLimit THEN 'Button was down, then up, within time limit. It's a click
IF _MOUSEBUTTON(BD) = 0 THEN tempMBS = 4 * 2 ^ ButtonDown: ButtonDown = 0: StartTimer = 0
ELSE
IF _MOUSEBUTTON(BD) = 0 THEN 'hold event has now ended
tempMBS = 0: ButtonDown = 0: StartTimer = 0
Mouse_EndX = _MOUSEX: Mouse_EndY = _MOUSEY
ELSE 'We've now started the hold event
tempMBS = tempMBS OR 32 * 2 ^ ButtonDown
END IF
END IF
END IF
MBS% = tempMBS
END FUNCTION 'MBS%
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ DISPLAY CHORD NAMES
SUB NameChords
IF _READBIT(togs, scale_on) THEN
FOR cn% = 1 TO 7
nt% = 0
FOR tri% = cn% TO cn% + 4 STEP 2
IF tri% > 7 THEN subtri% = tri% - 7 ELSE subtri% = tri%
FOR n% = nt% TO 56
SELECT CASE tri%
CASE cn%
IF note(n%).sd = subtri% THEN
chrdnm$ = _TRIM$(note(n% + 12).ft)
nt% = n%
EXIT FOR
END IF
CASE cn% + 2
IF note(n%).sd = subtri% THEN
third% = interval%
interval% = 0
nt% = n%
EXIT FOR
END IF
interval% = interval% + 1
CASE cn% + 4
IF note(n%).sd = subtri% THEN
fifth% = interval%
interval% = 0
EXIT FOR
END IF
interval% = interval% + 1
END SELECT
NEXT n%
NEXT tri%
IF third% = 4 THEN
chrdnm$ = chrdnm$ + "maj"
ELSEIF third% = 3 THEN
chrdnm$ = chrdnm$ + "min"
IF fifth% = 3 THEN chrdnm$ = chrdnm$ + CHR$(248)
END IF
_PRINTSTRING (bt(cn% + 52).r.lr.x + 2, bt(cn% + 52).r.ul.y + 4), chrdnm$
chrdnm$ = ""
NEXT cn%
END IF
END SUB 'NameChords
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ COLOR NEGATIVE
FUNCTION Negative~& (c AS _UNSIGNED LONG)
Negative~& = _RGBA32(127 - (_RED(c) - 127), 127 - (_GREEN(c) - 127), 127 - (_BLUE(c) - 127), _ALPHA(c))
END FUNCTION 'Negative~&
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ GET A NOTE NAME IN CONTEXT OF SHARP/FLAT
FUNCTION NoteName$ (n AS tone)
IF n.ac THEN
IF _READBIT(togs, shrp_flt) THEN
NoteName$ = n.bf
ELSE
NoteName$ = n.bs
END IF
ELSE
NoteName$ = n.nt
END IF
END FUNCTION 'NoteName$
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ RETURN ARRAY POSITION OF A TARGET TONE
FUNCTION NotePosition% (arr() AS tone, tar AS tone)
ft$ = tar.nt + tar.bf + tar.bs
DO
gt$ = arr(x%).nt + arr(x%).bf + arr(x%).bs
IF ft$ = gt$ THEN
NotePosition% = x%: EXIT FUNCTION
END IF
x% = x% + 1
LOOP UNTIL x% = UBOUND(arr) + 1
END FUNCTION 'NotePosition
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ CLEAR ALL NOTE PICKS
SUB Note_Zero
togs = _RESETBIT(togs, picked) ' no notes picked
togs = _RESETBIT(togs, scale_on) ' scale absent
togs = _RESETBIT(togs, chordset)
FOR s% = 7 TO 13
togs = _RESETBIT(togs, s%)
NEXT s%
IF NOT _READBIT(togs, mode_lock) THEN ' if not scale locked
ResetScale ' reset to Ionian
FOR x% = 0 TO 6
IF _READBIT(togs, x%) THEN togs = _TOGGLEBIT(togs, x%) 'clear all scale ID bits
NEXT x%
togs = _SETBIT(togs, 0) ' default to Ionian/Major
END IF
tonic.nt = "" ' blank tonic note
tonic.bs = ""
tonic.bf = ""
FOR c% = 0 TO 56 ' blank all note choices
note(c%).sd = 0
note(c%).c = 0
note(c%).ft = NoteName(note(c%))
NEXT c%
END SUB 'Note_Zero
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ MOVE BY PERFECT FIFTH
FUNCTION Pfifth% (v AS INTEGER, ad AS INTEGER)
v1 = v + ad
Pfifth% = v1 + 12 * (v1 >= 12) - 12 * (v1 < 0)
END FUNCTION 'Pfifth%
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ ARROW INDICATOR
SUB RegionArrow (r AS region, ori AS STRING, fill AS STRING, col AS _UNSIGNED LONG)
DIM AS V2 pt, pl, pr
c& = _NEWIMAGE(1, 1, 32)
_DEST c&
CLS , col
_DEST 0
mx% = _SHR(r.lr.x - r.ul.x, 1) + r.ul.x
my% = _SHR(r.lr.y - r.ul.y, 1) + r.ul.y
SELECT CASE LCASE$(ori)
CASE "u" ' Arrow UP
IF fill = "full" THEN my% = r.lr.y
pt.x = mx%: pt.y = r.ul.y
pl.x = r.ul.x: pl.y = my%
pr.x = r.lr.x: pr.y = my%
CASE "r" ' Arrow RIGHT
IF fill = "full" THEN mx% = r.ul.x
pt.x = r.lr.x: pt.y = my%
pl.x = mx%: pl.y = r.ul.y
pr.x = mx%: pr.y = r.lr.y
CASE "d" ' Arrow DOWN
IF fill = "full" THEN my% = r.ul.y
pt.x = mx%: pt.y = r.lr.y
pl.x = r.lr.x: pl.y = my%
pr.x = r.ul.x: pr.y = my%
CASE "l" ' Arrow LEFT
IF fill = "full" THEN mx% = r.lr.x
pt.x = r.ul.x: pt.y = my%
pl.x = mx%: pl.y = r.lr.y
pr.x = mx%: pr.y = r.ul.y
END SELECT
_MAPTRIANGLE (0, 0)-(0, 0)-(0, 0), c& TO(pl.x, pl.y)-(pt.x, pt.y)-(pr.x, pr.y)
_FREEIMAGE c&
END SUB 'RegionArrow
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ HIGHLIGHT BUTTON EDGE
SUB RegionRing (r AS region, col AS _UNSIGNED LONG, t AS INTEGER)
b% = t \ 3
FOR c% = 0 TO t - 1
IF c% < b% OR c% = t - 1 THEN clr& = Black ELSE clr& = col
LINE (r.ul.x + c%, r.ul.y + c%)-(r.lr.x - c%, r.lr.y - c%), clr&, B
NEXT c%
END SUB 'RegionRing
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ RESET TO IONIAN/MAJOR SCALE
SUB ResetScale
$CHECKING:OFF
DIM AS _MEM m, s
m = _MEM(masterscale())
s = _MEM(scale())
_MEMCOPY m, m.OFFSET, m.SIZE TO s, s.OFFSET
_MEMFREE m: _MEMFREE s
$CHECKING:ON
END SUB 'ResetScale
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ ROTATE SCALE ARRAYS MEM BASED
SUB RotArrayM (arr() AS _BYTE, rt%)
IF rt% = 0 THEN EXIT SUB
cr1% = ABS(rt%): cr2% = 0
$CHECKING:OFF
DIM AS _MEM ar, t
ar = _MEM(arr()): t = _MEMNEW(cr1%)
bl%& = ar.SIZE - cr1%
st%& = -(rt% > 0) * bl%& ' Rotate right=TRUE rotate left=FALSE
sl%& = -(rt% < 0) * bl%& ' Rotate left=TRUE rotate right=FALSE
_MEMCOPY ar, ar.OFFSET + st%&, cr1% TO t, t.OFFSET ' pop right or left rt% bytes to temp storage
IF st%& = 0 THEN SWAP cr1%, cr2% ' if left shift swap offsets
_MEMCOPY ar, ar.OFFSET + cr2%, bl%& TO ar, ar.OFFSET + cr1% 'shift remainder block right or left {if swapped}
IF st%& = 0 THEN SWAP cr1%, cr2% ' if left shift re-swap offsets
_MEMCOPY t, t.OFFSET, cr1% TO ar, ar.OFFSET + sl%& ' push temp storage to opposite end from pop
_MEMFREE ar: _MEMFREE t
$CHECKING:ON
END SUB 'RotArrayM
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ CREATE NOTE SCALE
SUB Scale_Run
DIM sc(11) AS _BYTE ' local scale array
DIM AS _MEM sg, sl
sg = _MEM(scale()): sl = _MEM(sc())
_MEMCOPY sg, sg.OFFSET, sg.SIZE TO sl, sl.OFFSET ' copy from global scale
_MEMFREE sg: _MEMFREE sl
sclcol = defcol
d% = 1 ' set initial degree counter to tonic
FOR x% = 0 TO 11 ' populate scale array with scale degrees {1-7} & index tonic
IF sc(x%) THEN sc(x%) = d%: d% = d% + 1 ' set scale degree & increment to next; supertonic, mediant, etc.
NEXT x%
RotArrayM sc(), NotePosition%(note(), tonic) ' rotate the local scale to align with note array
p% = 0
FOR n% = 0 TO 56 ' distribute local array across note array
IF sc(p%) THEN
note(n%).sd = sc(p%) ' set note scale degree
note(n%).c = sclcol ' and color
togs = _SETBIT(togs, picked) ' set picked note TRUE
END IF
p% = p% + 1 ' advance scale with note array loop
IF p% = 12 THEN p% = 0 ' reset scale if beyond upper bound
NEXT n%
END SUB 'Scale_Run
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ SEARCH FOR MATCHING TONE SINGLY OR ALL OCTAVES
SUB SearchNote (mode AS INTEGER, t AS tone)
IF _READBIT(togs, oct_sing) THEN ' search all octave examples
s% = NotePosition%(note(), t) '
DO
IF mode THEN ' mode: add note = TRUE
IF note(s%).sd = 0 THEN note(s%).sd = TRUE ' only set if not in a scale (keep scale degrees)
note(s%).c = defcol ' change color regardless
togs = _SETBIT(togs, picked)
ELSE ' mode: remove note = FALSE
note(s%).sd = FALSE ' clear this note
note(s%).c = 0 ' and reset its color
END IF
s% = s% + 12 ' jump to next octave
LOOP UNTIL s% > 56
ELSE ' search only matching octave
IF mode THEN
IF t.sd = 0 THEN t.sd = TRUE
t.c = defcol
togs = _SETBIT(togs, picked)
ELSE
t.sd = FALSE
t.c = 0
END IF
END IF
END SUB 'SearchNote
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ CREATE CHROMATIC TONE ARRAY
SUB SetNote (q() AS tone)
nt$ = "CDEFGAB" ' cardinal note string
n = UBOUND(q)
FOR x% = 0 TO n ' iterate full tone array
deg% = x% MOD 12 ' compute chromatic degree from C=0
SELECT EVERYCASE deg%
CASE 0, 2, 4, 5, 7, 9, 11 ' white key cardinal notes {C D E F G A B}
ni% = ni% + 1 ' increment note name index
IF ni% = 8 THEN ni% = 1 ' keep index in 1-7 range
q(x%).nt = MID$(nt$, ni%, 1) ' set natural note name
q(x%).ac = FALSE ' note is not an accidental
H! = Hz(deg%)
CASE 4, 11 ' E, B flats
c% = -(deg% = 11) - (ni% + 1) * (deg% = 4) ' B(11) sets a 1 : E(4) sets to next name index
q(x%).bf = MID$(nt$, c%, 1) + "b"
CASE 0, 5 ' C, F sharps
c% = -7 * (deg% = 0) - (ni% - 1) * (deg% = 5) ' C(0) sets last name index : F(5) sets previous index
q(x%).bs = MID$(nt$, c%, 1) + "#"
CASE 1, 3, 6, 8, 10 ' black key accidental notes {C# D# F# G# A#}
q(x%).nt = "*"
q(x%).bs = MID$(nt$, ni%, 1) + "#" ' sharp name
q(x%).bf = MID$(nt$, ni% + 1, 1) + "b" ' flat name
q(x%).ac = TRUE ' note is an accidental
H! = Hz(deg%)
END SELECT
q(x%).oc = INT(x% / 12) + 1
q(x%).hz = CINT(H! * (2 ^ q(x%).oc)) ' calculate tone cycles
q(x%).indx = x%
NEXT x%
END SUB 'SetNote
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ SELECT SHARP/FLAT KEY BIAS
SUB Signature (k%)
FOR x% = 0 TO 6
IF _READBIT(togs, x%) THEN EXIT FOR
NEXT x%
SELECT CASE x%
CASE 0:
SELECT CASE k% ' Ionian/Major
CASE 1, 3, 5, 6, 8, 10: togs = _SETBIT(togs, shrp_flt)
CASE 0, 2, 4, 7, 9, 11: togs = _RESETBIT(togs, shrp_flt)
END SELECT
CASE 1:
SELECT CASE k% ' Dorian
CASE 0, 1, 3, 5, 7, 8, 10: togs = _SETBIT(togs, shrp_flt)
CASE 2, 4, 6, 9, 11: togs = _RESETBIT(togs, shrp_flt)
END SELECT
CASE 2:
SELECT CASE k% ' Phrygian
CASE 0, 2, 3, 5, 7, 9, 10: togs = _SETBIT(togs, shrp_flt)
CASE 1, 4, 6, 8, 11: togs = _RESETBIT(togs, shrp_flt)
END SELECT
CASE 3:
SELECT CASE k% ' Lydian
CASE 1, 3, 6, 8, 10, 11: togs = _SETBIT(togs, shrp_flt)
CASE 0, 2, 4, 5, 7, 9: togs = _RESETBIT(togs, shrp_flt)
END SELECT
CASE 4:
SELECT CASE k% ' Mixolydian
CASE 0, 1, 3, 5, 6, 8, 10: togs = _SETBIT(togs, shrp_flt)
CASE 2, 4, 7, 9, 11: togs = _RESETBIT(togs, shrp_flt)
END SELECT
CASE 5:
SELECT CASE k% ' Aeolian/Minor
CASE 0, 2, 3, 5, 7, 8, 10: togs = _SETBIT(togs, shrp_flt)
CASE 1, 4, 6, 9, 11: togs = _RESETBIT(togs, shrp_flt)
END SELECT
CASE 6:
SELECT CASE k% ' Locrian
CASE 0, 2, 4, 5, 7, 9, 10: togs = _SETBIT(togs, shrp_flt)
CASE 1, 3, 6, 8, 11: togs = _RESETBIT(togs, shrp_flt)
END SELECT
END SELECT
END SUB 'Signature
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ HIGHLIGHT SCALE/NOTE FRET POSITIONS
FUNCTION SpotFret% (st AS INTEGER, fr AS INTEGER)
sr% = _HEIGHT(fb&) / 6 ' string range
y% = neckdown% + st * sr% + (sr% / 2) ' string position
IF fr = 0 THEN
a% = capo%
x% = nut% - .5 * sr% ' open string position
r% = .4 * sr%
ELSEIF fr > capo% THEN
a% = 0
x% = nut% + fr * Fret_Wide% - ((bridge% - nut%) / 48) ' fret position
r% = .5 * sr%
END IF
ps% = frets(st, fr) + a%
IF note(ps%).sd <> 0 THEN ' note chosen either scale or individually
SpotFret% = TRUE
c~& = note(ps%).c
IF note(ps%).sd = 1 THEN ' note is a scale tonic
DIM AS _UNSIGNED LONG rred, grn, blu, alf
rred = _RED32(c~&): grn = _GREEN32(c~&): blu = _BLUE32(c~&)
alf = _ALPHA32(c~&)
FOR rr% = r% TO 0 STEP -1 ' draw hemi gradient for tonic note
f = 1 - SIN((rr% * .5) / r%)
IF f > 1 THEN f = 1
FCirc x%, y%, rr%, _RGBA32(rred * f, grn * f, blu * f, alf)
CIRCLE (x%, y%), r%, Black
NEXT
ELSE ' note single or scale degree 2-7
FCirc x%, y%, r%, c~&
CIRCLE (x%, y%), r%, Black ' add contrast border
IF note(ps%).sd <> -1 THEN ' note a non-root scale degree
Divisions x%, y%, r%, note(ps%).sd, note(ps%).c
END IF
END IF
ELSE
SpotFret% = FALSE
END IF
END FUNCTION 'SpotFret%
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ DEFINE CLEAN STAFF IMAGE
SUB Staff
_DEST st&
CLS , White
y% = _HEIGHT(st&) * .45
sp% = _HEIGHT(st&) * .05
gc$ = "FEDCBAGFE"
fc$ = "AGFEDCBAG"
COLOR Green
_PRINTMODE _KEEPBACKGROUND
FOR x% = 0 TO 4
IF x% < 4 THEN
LINE (_WIDTH * .01, y% + (sp% * x%))-(_WIDTH(st&) * .02, y% + sp% + (sp% * x%)), Black, BF
LINE (_WIDTH * .01, y% + (sp% * (x% + 6)))-(_WIDTH(st&) * .02, y% + sp% + (sp% * (x% + 6))), Black, BF
_PRINTSTRING (_WIDTH - 20, y% + (sp% * x%)), _TRIM$(MID$(gc$, (x% * 2) + 2, 1))
_PRINTSTRING (_WIDTH - 20, y% + (sp% * (x% + 6))), _TRIM$(MID$(fc$, (x% * 2) + 2, 1))
END IF
LINE (_WIDTH * .01, y% + (sp% * x%))-(_WIDTH(st&), y% + (sp% * x%)), Black, BF
LINE (_WIDTH * .01, y% + (sp% * (x% + 6)))-(_WIDTH(st&), y% + (sp% * (x% + 6))), Black, BF
_PRINTSTRING (_WIDTH - 10, y% + (sp% * x%) - 8), _TRIM$(MID$(gc$, (x% * 2) + 1, 1))
_PRINTSTRING (_WIDTH - 10, y% + (sp% * (x% + 6)) - 8), _TRIM$(MID$(fc$, (x% * 2) + 1, 1))
NEXT x%
COLOR White
FOR x% = -1 TO -8 STEP -1 ' short ledgers
LINE (_WIDTH / 2 - 20, y% + (sp% * x%))-(_WIDTH(st&) - 1, y% + (sp% * x%)), Gray, , &HFF00 ' gray dotted upper registers
NEXT x%
Image_Resize 0, _HEIGHT(st&) * .325, _WIDTH(st&) - 1, _HEIGHT(st&) * 1.075, clefp&, st&, "l", "c"
_FREEIMAGE clefp&
_DEST 0
END SUB 'Staff
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ NOTATE GRANDSTAFF
SUB Stafftmp (a%, t AS tone)
radius% = _HEIGHT(st&) * 0.025
IF a% THEN ' noted staff
_DEST sttmp&
_PUTIMAGE , st& ' grand staff underlay
sp$ = LEFT$(t.ft, 2)
IF sp$ = "Cb" THEN ad% = 0 ELSE ad% = 1 ' trap Cb1 wrong staff position
IF sp$ = "B#" THEN ad% = 2 ' trap B# octave lift
nf% = INSTR("CDEFGAB", LEFT$(sp$, 1)) - 1
k% = _HEIGHT(st&) * (.875 - (t.oc - ad%) * .176 - nf% * 0.025) + 1
IF MID$(sp$, 2, 1) <> "" THEN
c& = _DEFAULTCOLOR
COLOR Black
_PRINTMODE _KEEPBACKGROUND
_PRINTSTRING (_WIDTH / 2 - 16, k% - 16), MID$(sp$, 2, 1)
COLOR c&
END IF
FCirc _WIDTH / 2, k%, radius%, Black ' display chosen tone
IF t.indx = 12 AND sp$ <> "B#" THEN
LINE (_WIDTH / 2 - radius% * 1.5, k% - 1)-(_WIDTH / 2 + radius% * 1.5, k% + 1), Black, BF
END IF
ELSE ' clean staff
_DEST sttmp&
_PUTIMAGE , st& ' overlay clean staff image
END IF
IF _READBIT(togs, scale_on) THEN ' SCALE MODE- display key signature
COLOR Black
IF _READBIT(togs, shrp_flt) THEN ' add flats
fs$ = "Bb2Eb3Ab2Db3Gb2Cb3Fb2": ac$ = "b": s& = flat&
ELSE ' add sharps
fs$ = "F#3C#3G#3D#3A#2E#3B#2": ac$ = "#": s& = sharp&
END IF
DO
IF note(x% + 12).sd > 0 AND MID$(note(x% + 12).ft, 2, 1) = ac$ THEN acc% = acc% + 1
x% = x% + 1
LOOP UNTIL x% = 12
wd% = _HEIGHT(st&) * .05 ' let width equal line spacing
ht% = _SHL(wd%, 1) ' double that for height
foff% = _HEIGHT(st&) * .350 ' F clef offset
_PRINTMODE _KEEPBACKGROUND
FOR b% = 1 TO acc%
sig$ = MID$(fs$, 3 * (b% - 1) + 1, 3)
sig% = VAL(MID$(sig$, 3, 1))
np% = INSTR("CDEFGAB", LEFT$(sig$, 1)) - 1
lp% = _HEIGHT(st&) * (.875 - ((sig% - 1) * .176) - (np% * 0.025))
x1% = b% * (wd% * .75) + _WIDTH(st&) * .15
x2% = x1% + wd%
y1% = lp% - (ht% * .75)
y2% = lp% + (ht% * .25)
Image_Resize x1%, y1%, x2%, y2%, s&, sttmp&, "c", "c" 'place G clef signature
Image_Resize x1%, y1% + foff%, x2%, y2% + foff%, s&, sttmp&, "c", "c" 'place F clef signature
NEXT b%
COLOR White
END IF
_DEST 0
END SUB 'Stafftmp
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ APPLY NOTES TO FRETBOARD
SUB String_Notes
dfc& = _DEFAULTCOLOR
COLOR Aqua
fr_rng% = Fret_Wide%
st_rng% = (_HEIGHT(fb&) - 1) / 6
FOR st% = 0 TO 5 ' strings
st_ps% = st_rng% * st% + (_SHR(st_rng%, 1))
FOR fr% = 0 TO fretmax% ' frets
IF fr% = 0 THEN
az% = capo%: xp% = nut% - (_SHR(fr_rng%, 1)) - 8
ELSE
az% = 0: xp% = nut% + (fr% * fr_rng%) - (_SHR(fr_rng%, 1)) - 4
END IF
ps% = frets(st%, fr% + az%)
n$ = NoteName(note(ps%)) ' set a standard mode name until otherwise indicated
'Here we determine if any sharp or flat alternates are needed
IF _READBIT(togs, scale_on) THEN ' if scale mode
IF note(ps%).sd > 0 THEN ' if note in scale
IF _READBIT(togs, shrp_flt) THEN ' look behind to last chromatic note
IF note(ps% - 1).sd > 0 THEN
IF LEFT$(n$, 1) = LEFT$(NoteName(note(ps% - 1)), 1) THEN
IF note(ps%).bf <> "" THEN n$ = note(ps%).bf
END IF
END IF
ELSE ' look ahead to next scale note
IF note(ps% + 1).sd > 0 THEN
IF LEFT$(n$, 1) = LEFT$(NoteName(note(ps% + 1)), 1) THEN
IF note(ps%).bs <> "" THEN n$ = note(ps%).bs '
END IF '
END IF '
IF ps% = 0 THEN
IF note(11).sd > 0 THEN
IF LEFT$(n$, 1) = LEFT$(NoteName(note(11)), 1) THEN
IF note(ps%).bs <> "" THEN n$ = note(ps%).bs
END IF
END IF
ELSE
IF note(ps% - 1).sd > 0 THEN
IF LEFT$(n$, 1) = LEFT$(NoteName(note(ps% - 1)), 1) THEN
IF note(ps%).bs <> "" THEN n$ = note(ps%).bs
END IF
END IF
END IF
END IF ' end: sharp/flat test
END IF ' end: note in scale test
END IF ' end: scale mode test
note(ps%).ft = n$ ' set fret display note name
n$ = n$ + _TRIM$(STR$(note(ps%).oc)) ' add octave ID
IF _READBIT(togs, picked) THEN j% = SpotFret%(st%, fr%) '
IF _READBIT(togs, all_nat) AND note(ps%).ac THEN _CONTINUE
IF fr% = 0 OR fr% > capo% THEN ' print all not behind capo
IF _READBIT(togs, hide_show) THEN _PRINTSTRING (xp%, st_ps% + neckdown% - 4), n$
END IF
NEXT fr%
NEXT st%
COLOR dfc&
END SUB 'String_Notes
SUB String_NotesII
dfc& = _DEFAULTCOLOR
COLOR Aqua
fr_rng% = Fret_Wide%
st_rng% = (_HEIGHT(fb&) - 1) / 6
flat% = _READBIT(togs, shrp_flt)
FOR st% = 0 TO 5 ' strings
st_ps% = st_rng% * st% + (_SHR(st_rng%, 1))
FOR fr% = 0 TO fretmax% ' frets
IF fr% = 0 THEN
az% = capo%: xp% = nut% - (_SHR(fr_rng%, 1)) - 8
ELSE
az% = 0: xp% = nut% + (fr% * fr_rng%) - (_SHR(fr_rng%, 1)) - 4
END IF
ps% = frets(st%, fr% + az%)
n$ = NoteName(note(ps%)) ' set a standard mode name until otherwise indicated
'Here we determine if any sharp or flat alternates are needed
IF _READBIT(togs, scale_on) THEN ' if scale mode
IF note(ps%).sd > 0 THEN ' if note in scale
look% = (11 * (ps% = 0) + (ps% - 1) * (ps% > 0)) * (flat%) - (ps% + 1) * (NOT flat%)
IF note(look%).sd > 0 THEN
IF LEFT$(n$, 1) = LEFT$(NoteName(note(look%)), 1) THEN
IF flat% THEN
IF note(ps%).bf <> "" THEN n$ = note(ps%).bf
ELSE
IF note(ps%).bs <> "" THEN n$ = note(ps%).bs
END IF
END IF
END IF
END IF ' end: note in scale test
END IF ' end: scale mode test
note(ps%).ft = n$ ' set fret display note name
n$ = n$ + _TRIM$(STR$(note(ps%).oc)) ' add octave ID
IF _READBIT(togs, picked) THEN j% = SpotFret%(st%, fr%) '
IF _READBIT(togs, all_nat) AND note(ps%).ac THEN _CONTINUE
IF fr% = 0 OR fr% > capo% THEN ' print all not behind capo
IF _READBIT(togs, hide_show) THEN _PRINTSTRING (xp%, st_ps% + neckdown% - 4), n$
END IF
NEXT fr%
NEXT st%
COLOR dfc&
END SUB 'String_NotesII
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ DISPLAY SCALE INFO
SUB Circle_of_Fifth
in% = 9 ' starting at 3 o'clock
x% = _SHR(bt(20).r.lr.x, 1) ' center (x%, y%) of circle
y% = bt(20).r.ul.y + x%
rds% = x% * .9 ' outer note ring
rdf% = x% * .7 ' inner note ring
rdc% = x% * .3 ' clear all ring
rhf% = (rds% - rdf%) / 2 ' half ring offset
LINE (bt(20).r.ul.x, bt(20).r.ul.y)-(bt(20).r.lr.x, bt(20).r.lr.y), &H7F7F7F7F, B
CIRCLE (x%, y%), rdc%, Red
CIRCLE (x%, y%), rds%, Red: CIRCLE (x%, y%), rds% + 2, Blue
CIRCLE (x%, y%), rdf%, Red
FOR i% = 0 TO 11
tc! = COS(.523598 * i%): ts! = SIN(.523598 * i%) ' text point angle _PI / 6 = .523598
pc! = COS(.523598 * i% - .261799): ps! = SIN(.523598 * i% - .261799) 'dividing line angle _PI / 12 = .261799
tx% = x% + (rhf% + rdf%) * tc! ' text center x
ty% = y% + (rhf% + rdf%) * ts! ' text center y
hi% = in% + 12
n$ = NoteName$(note(hi%))
IF _READBIT(togs, scale_on) THEN ' if scale chosen
IF NoteName$(tonic) = n$ THEN ' if note is tonic
FCirc tx%, ty%, 15, Gray ' mark it
END IF
ox% = x% + (rdf% - rhf%) * tc! ' object center x
oy% = y% + (rdf% - rhf%) * ts! ' object center y
IF _READBIT(togs, shrp_flt) THEN ks$ = "b" ELSE ks$ = "#"
IF note(hi%).sd > 0 THEN
IF note(hi%).nt = "*" OR note(hi%).ft = "Cb" OR note(hi%).ft = "E#" OR note(hi%).ft = "B#" OR note(hi%).ft = "Fb" THEN
IF note(hi%).ft = "Cb" THEN n$ = "Cb"
IF note(hi%).ft = "E#" THEN n$ = "E#"
IF note(hi%).ft = "B#" THEN n$ = "B#"
IF note(hi%).ft = "Fb" THEN n$ = "Fb"
FCirc ox%, oy%, 10, Red
ELSE
FCirc ox%, oy%, 10, Blue
END IF
Divisions ox%, oy%, 10, note(hi%).sd, Black
END IF
END IF
_PRINTSTRING (tx% - (4 * LEN(n$)), ty% - 8), n$ ' print note in note ring position
'_PRINTSTRING ((tx% + x%) / 2 - (4 * LEN(n$)), (ty% + y%) / 2 - 8), _TRIM$(STR$(hi% - 12)) ' debugging and pattern aid
LINE (x% + rdf% * pc!, y% + rdf% * ps!)-(x% + rds% * pc!, y% + rds% * ps!), Red
in% = Pfifth%(in%, -5)
NEXT i%
_PRINTSTRING (x% - 36, y% - 8), "Clear All"
IF _READBIT(togs, mode_lock) THEN
COLOR Red
_PRINTSTRING (x% - 36, y% - (x% * .4)), "Mode Lock"
COLOR White
END IF
END SUB 'Circle_of_Fifth
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ VECTOR ADDITION
SUB R2_Add (re AS V2, se AS V2, m AS INTEGER)
re.x = re.x + se.x * m
re.y = re.y + se.y * m
END SUB 'R2_Add
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ VECTOR MAGNITUDE
FUNCTION R2_Mag! (v AS V2)
R2_Mag! = _HYPOT(v.x, v.y)
END FUNCTION 'R2_Mag!
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ COMMENTS AND NOTES
SUB Theory
' I II III IV V VI VII I
'tonic, supertonic, mediant, subdominant, dominant, submediant, leading and tonic.
'KEY #SHARP/FLAT SHARP/FLAT LIST I ii iii IV V vi vii RELATIVE MINOR
'C# major 7 sharps F#-C#-G#-D#-A#-E#(F)-B#(C) C#- D#- E#(F)- F#- G#- A#- B#(C)
'F# major 6 F#-C#-G#-D#-A#-E#(F) F#- G#- A#- B- C#- D#- E#(F)
'B major 5 F#-C#-G#-D#-A# B- C#- D#- E- F#- G#- A# Ab minor
'E major 4 F#-C#-G#-D# E- F#- G#- A- B- C#- D# Db minor
'A major 3 F#-C#-G# A- B- C#- D- E- F#- G# Gb minor
'D major 2 F#-C# D- E- F#- G- A- B- C# B minor
'G major 1 F# G- A- B- C- D- E- F# E minor
'C major - C- D- E- F- G- A- B A minor
'F major 1 flat Bb F- G- A- Bb- C- D- E D minor
'Bb major 2 Bb-Eb Bb- C- D- Eb- F- G- A G minor
'Eb major 3 Bb-Eb-Ab Eb- F- G- Ab- Bb- C- D C minor
'Ab major 4 Bb-Eb-Ab-Db Ab- Bb- C- Db- Eb- F- G F minor
'Db major 5 Bb-Eb-Ab-Db-Gb Db- Eb- F- Gb- Ab- Bb- C Bb minor
'Gb major 6 Bb-Eb-Ab-Db-Gb-Cb(B) Gb Ab Bb Cb(B)- Db Eb F Eb minor
'Cb major 7 Bb-Eb-Ab-Db-Gb-Cb(B)-Fb(E) Cb(B)- Db- Eb- Fb(E)- Gb- Ab- Bb Ab minor
'INTERVALS
'0 perfect unison
'1 minor 2nd...............semitone
'2 major 2nd...............tone
'3 minor 3rd
'4 major 3rd
'5 perfect 4th
'6 aug 4th/dim 5th.........tritone
'7 perfect 5th
'8 minor 6th
'9 major 6th
'10 minor 7th
'11 major 7th
'12 octave
'MNEMONICS
'Father Charles Goes Down And Ends Battle
'Battle Ends And Down Goes Charles Father
END SUB 'Theory
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ CLEAR CHORD COLOR
SUB UnChord
FOR x% = 0 TO 56
IF note(x%).sd > 0 THEN
note(x%).c = sclcol
END IF
NEXT x%
END SUB 'UnChordRE: Learning guitar - bplus - 03-15-2025
+1 love idea of mixing your hobbies here!
I remember a while back Luke was doing an interpreter (or something with programming) with music!
RE: Learning guitar - grymmjack - 03-15-2025
Very cool @OldMoses. I can see a lot of love and planning went into this! I also play guitar (well not as much because my hands hurt after about 10 minutes).
Here is a screenshot to get more people interested possibly (always post a screenshot if you can):
![[Image: screenshot.png]](https://i.ibb.co/XfZpypY3/screenshot.png)
This is super advanced and awesome. I get no sound how do I make it play sounds?
Otherwise awesome.
One note - I had to modify the source so the embeds could find the assets in the same directory as the program:
Code: (Select All)
$EMBED:'./sharp2.png','emsharp'
$EMBED:'./flat.png','emflat'
$EMBED:'./clef pair.png','emclefp'
This worked good on windows. I'm not sure if the filenames with spaces would work in Linux or not, I'll check later.
Overall really kick ass work. This is significantly better than a lot of other tools. Would love to get it working with sound
Thank you for sharing @OldMoses
RE: Learning guitar - NakedApe - 03-16-2025
I play guitar and this is very cool, @OldMoses! I guess I need some more instructions though on how to use the program. I click around on the screen, but I'm not sure what the heck I'm doing. The fretboard quickly fills up with dots. Can you give us an example of how to use this por favor?
RE: Learning guitar - OldMoses - 03-17-2025
My apologies for my tendency to make user interface somewhat cryptic.
Playing sounds is a center mouse button function. The Silent/Sound is set either by hotkey 's' or by left mouse click to Sound mode, then the center mouse button click on the fret board will play a basic SOUND tone for the note chosen.
LEFT MOUSE BUTTON CLICK ON...
Top row toggles to flip the toggle states.
Fret board to set a note. Expand or contract the fretboard from 14-24 frets with the arrows at the right.
Capo Position track to set a capo (left click on position fret '0' to clear)
Mode buttons to set a mode (Ionian, Dorian, Lydian, etc.)
Circle of Fifths outer ring to pick a scale. Center circle to clear all selections or hotkey backspace.
Chords (I, II, III, etc.) to select a chord in the chosen key. Negative color values will highlight the notes of that chord
Colors to chose desired color.
RIGHT MOUSE BUTTON CLICK ON...
Fret board to clear a note.
Capo Position track to set a upper fret board mask (right click on position fret '0' to clear)
Mode buttons (any) to lock the mode selections. If mode is not locked it will revert to Ionian/Major keys on subsequent selections.
Colors to access color changing dialog which can be saved with a left click on "save colors"
CENTER MOUSE BUTTON CLICK ON...
Fret board to sound a tone when the silent/sound toggle is set to sound.
TOGGLES
Octave/Single: picks either all octaves of a note or a single octave example of that note. no hotkey for this one.
All/Natural: displays all note names or just the natural note names. hotkey a
Show/Hide: displays or hides all note names. hotkey h
Sharp/Flat: forces notes to display as either sharp or flat. This will display holes in the names if the pattern cannot be resolved. hotkey b
Silent/Sound: disables or enables center mouse tone generation. hotkey s
Keyboard: Hides or displays keyboard graphic. hotkey k
Tuners should be pretty self evident to use.
RE: Learning guitar - madscijr - 03-17-2025
(03-15-2025, 01:58 PM)OldMoses Wrote: I've been learning it for 30+ years and still haven't figured it out.Thanks for sharing. I play guitar by ear and don't know music theory at all. A program like this could be helpful with learning the different concepts, if it lets you visualize a concept and hear it at the same time.
Here's a little visual aid I came up with to help with scales, modes, chords, etc.
I haven't played with your program enough for detailed feedback yet, but here are a couple comments:
In sound mode, the tone the program uses for "playing" a note makes it easy to hear the pitch, however it's a little painful to my ear. If you could add in some options for choosing or customizing the tones such as
- choose a different waveform (e.g., square wave, triangle wave, sawtooth)
- adjust the volume
- change the attack/decay/sustain/release, etc.
- save sound settings to a name which is included in the options list when choosing a sound
Or perhaps make it able to play MIDI notes, and let the user choose the instrument from a list of GM instruments? I saw a thread on here on Exploring QB64-PE default soundfont patches which could help do that. (Also I asked about how to do MIDI I/O to real MIDI devices and @grymmjack mentioned they are working on adding support for this to QB64PE in the future - you might ask him or @a740g.)
Also, I like that the tuner gives the ability to tune individual strings and use a capo. Maybe later add an option to change the number of strings (so you can have 7-string guitar, 4-strings for ukelele or bass guitar, 5 strings for banjo, etc.) and some preset tunings (like ukelele tuning or some common open tunings), with the ability to define and save custom instruments & tunings that can be loaded?
Thanks again for sharing this - I'll play with this some more and let you know if I have any other feedback.
PS I also have written some guitar and music programs (most of them >20 years ago!) and this may inspire me to go back and update those using QB64PE.
RE: Learning guitar - OldMoses - 03-18-2025
(03-17-2025, 07:18 PM)madscijr Wrote:I play flute by ear, having a decent ear to pick up a melody, but find guitar more challenging. Flute is somewhat linear while guitar fret boards pose an extra dimension to try to wrap my head around.(03-15-2025, 01:58 PM)OldMoses Wrote: I've been learning it for 30+ years and still haven't figured it out.Thanks for sharing. I play guitar by ear and don't know music theory at all. A program like this could be helpful with learning the different concepts, if it lets you visualize a concept and hear it at the same time.
Here's a little visual aid I came up with to help with scales, modes, chords, etc.
One of the primary reasons I wrote this was to help me quickly translate chord voicings for different capo positions.
I found a more updated version of this. A tad better polished code which now incorporates @grymmjack's embed fix. It adds a visual cue in the circle of fifths of scale roots in green, which indicates which scales can be either sharp or flat without breaking the note pattern. I wasn't going to try programming absurd things like double sharps/flats.
Code: (Select All)
OPTION _EXPLICIT
'Fretboard IV
'Coding in QB64 Phoenix edition ver. 3.13.1
'by Richard Wessel
$EMBED:'./sharp2.png','emsharp'
$EMBED:'./flat.png','emflat'
$EMBED:'./clef pair.png','emclefp'
$COLOR:32
_TITLE "Fret Board 4.4.1 <esc> or <Q> to Quit"
TYPE V2 ' < X, Y > pair
x AS INTEGER
y AS INTEGER
END TYPE
TYPE region ' rectangular region defined by two diagonal < X, Y > pairs
ul AS V2 ' upper left point
lr AS V2 ' lower right point
END TYPE
TYPE button
hn AS LONG ' button image handle
l AS STRING * 20 ' label
r AS region ' position
c AS _UNSIGNED LONG ' color
h AS INTEGER ' hotkey position
END TYPE
TYPE tone
nt AS STRING * 1 ' natural name
bs AS STRING * 2 ' sharp name
bf AS STRING * 2 ' flat name
ac AS _BYTE ' natural(0) / accidental(-1)
oc AS _BYTE ' octave assignment
sd AS _BYTE ' scale degree
ft AS STRING * 2 ' fret name
c AS _UNSIGNED LONG ' color
hz AS SINGLE ' base cycles
indx AS INTEGER ' array index
END TYPE
'PROGRAM STATE VARIABLES
DIM SHARED AS V2 mous
DIM SHARED AS button bt(59)
DIM SHARED AS tone note(56), tonic
DIM SHARED AS INTEGER frets(5, 25) ' frets( string, fret) value = note(index)
DIM SHARED AS _BYTE masterscale(11), scale(11)
DIM SHARED AS _UNSIGNED LONG defcol, sclcol
DIM SHARED AS LONG togs ' TOGGLES
' 0= Ionian/Major scale
' 1= Dorian scale
' 2= Phrygian scale
' 3= Lydian scale
' 4= Mixolydian scale
' 5= Aeolian/Minor scale
' 6= Locrian scale
' 7= Chord I
' 8= Chord II
' 9= Chord III
' 10= Chord IV
' 11= Chord V
' 12= Chord VI
' 13= Chord VII
' ...
CONST chordset = 21 ' 21= chord clear(0)/chord set(1)
CONST mode_lock = 22 ' 22= mode lock off(0)/on(1)
CONST key_show = 23 ' 23= keyboard hide(0)/keyboard show(1)
CONST col_chg = 24 ' 24= color unchanged(0)/color changed(1)
CONST slnt_snd = 25 ' 25= silent(0)/sound(1)
CONST scale_on = 26 ' 26= scale absent(0)/scale present(1)
CONST picked = 27 ' 27= no notes(0)/picked notes(1)
CONST all_nat = 28 ' 28= all notes(0)/naturals only(1)
CONST hide_show = 29 ' 29= hide notes(0)/show notes(1)
CONST oct_sing = 30 ' 30= single(0)/octave(1)
CONST shrp_flt = 31 ' 31= sharp(0)/flat(1)
CONST TRUE = -1
CONST FALSE = 0
CONST outring = .8
CONST inring = .6
'DISPLAY LIMIT VARIABLES
DIM SHARED scrw%, scrh%, neckdown%, nut%, bridge%, fretmax%
DIM SHARED capo%, capotop%, capobot%
DIM SHARED frlimit%
'IMAGE HANDLES
DIM SHARED fb&, st&, sttmp&, sharp&, flat&, clefp&
'INITIAL VALUES
IF _DESKTOPHEIGHT - 80 * 1.82 > _DESKTOPWIDTH - 80 THEN
scrh% = _DESKTOPHEIGHT - 80
scrw% = scrh% * 1.82
ELSE
scrw% = _DESKTOPWIDTH - 80
scrh% = scrw% * .55
END IF
'DISPLAY LIMIT VALUES
neckdown% = scrh% * .05
capotop% = scrh% * .37
capobot% = scrh% * .4
nut% = scrw% * .15 ' nut position
bridge% = scrw% * .95 ' beyond here is only the bridge
fretmax% = 14 ' maximum # of frets shown
togs = &HE0000001 '&B11100000000000000000000000000001
defcol = Blue
'SCREENS & IMAGES
fb& = _NEWIMAGE(scrw%, scrh% * .3, 32)
st& = _NEWIMAGE(scrw% * .25, scrh% * .4, 32) ' grand staff underlayment image
sttmp& = _NEWIMAGE(scrw% * .25, scrh% * .4, 32) ' grand staff working image
sharp& = _LOADIMAGE(_EMBEDDED$("emsharp"), 32, "memory") ' key signature sharp image
flat& = _LOADIMAGE(_EMBEDDED$("emflat"), 32, "memory") ' key signature flat image
clefp& = _LOADIMAGE(_EMBEDDED$("emclefp"), 32, "memory") ' grand staff clef image
SCREEN _NEWIMAGE(scrw%, scrh%, 32)
DO: LOOP UNTIL _SCREENEXISTS
_SCREENMOVE 0, 0
masterscale(0) = TRUE ' tonic create master scale array
masterscale(2) = TRUE ' whole step
masterscale(4) = TRUE ' whole step
masterscale(5) = TRUE ' half step
masterscale(7) = TRUE ' dominant whole step
masterscale(9) = TRUE ' whole step
masterscale(11) = TRUE 'leading whole step -> half step back to 0
ResetScale ' copy master scale to scale
SetNote note() ' create main tone UDT array
Init_Strings 24 ' populate string values to 24 frets
Fret_Board ' draw fretboard
Make_Buttons ' draw control images
Staff ' Create clean grand staff image
Stafftmp 0, note(0) ' overlay un-notated temp staff image
MainLoop '
END
'---------------------------------------------------------------END MAIN MODULE---------------------
'---------------------------------------------------------------SUBROUTINES-------------------------
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ CONBLOK BUTTON BEVEL
SUB BevelB (xsiz AS INTEGER, ysiz AS INTEGER, col AS _UNSIGNED LONG)
DIM brdr, rd&, gn&, bl&, bb, c
brdr = ABS(_SHR(ysiz, 2) * (ysiz <= xsiz) + _SHR(xsiz, 2) * (ysiz > xsiz)) 'select smaller 1/4 size border axis
rd& = _RED32(col) - 100: gn& = _GREEN32(col) - 100: bl& = _BLUE32(col) - 100
FOR bb = 0 TO brdr
c = c + 100 / brdr
LINE (0 + bb, 0 + bb)-(xsiz - 1 - bb, ysiz - 1 - bb), _RGBA32(rd& + c, gn& + c, bl& + c, _ALPHA(col)), B
NEXT bb
END SUB 'BevelB
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ DISPLAY BUTTON AS <OFF>
SUB ButBlank (b AS INTEGER)
LINE (bt(b).r.ul.x, bt(b).r.ul.y)-(bt(b).r.lr.x, bt(b).r.lr.y), &H7F000000, BF
END SUB 'ButBlank
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ DISPLAY BUTTON
SUB ButPut (b AS INTEGER)
_PUTIMAGE (bt(b).r.ul.x, bt(b).r.ul.y)-(bt(b).r.lr.x, bt(b).r.lr.y), bt(b).hn
END SUB 'ButPut
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ DISPLAY CAPO BLANKING
SUB Capo_Track
DIM fw%, tps%, fr%, x%
fw% = Fret_Wide%
tps% = MidPt%(capotop%, capobot%) - 8
_PRINTSTRING (4, tps%), "Capo Position"
FOR fr% = 0 TO fretmax%
x% = nut% + fw% * fr%
LINE (x% - fw%, capotop%)-(x%, capobot%), , B
IF fr% = capo% THEN _PRINTSTRING (x% - (fw% / 2), tps%), _TRIM$(STR$(fr%))
NEXT fr%
IF capo% THEN ' fretboard blanking
LINE (nut%, neckdown%)-(nut% + fw% * capo%, neckdown% + _HEIGHT(fb&)), &H7F000000, BF
END IF
END SUB 'Capo_Track
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ DISPLAY UPPER LIMIT BLANKING
SUB Limit_Track
IF frlimit% THEN
LINE (nut% + Fret_Wide% * frlimit%, neckdown%)-(bridge%, neckdown% + _HEIGHT(fb&)), &H7F000000, BF
END IF
END SUB 'Limit_Track
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ CHORD INVERSE COLOR
SUB Chord (d AS INTEGER)
DIM chrd&, ch%, triad%, n%
chrd& = Negative~&(sclcol) ' negative inversion of scale color
ch% = d
FOR triad% = 1 TO 3 ' degree of triad
FOR n% = 0 TO 56
IF note(n%).sd = ch% THEN ' if note scale degree equals chord degree
note(n%).c = chrd& ' apply negative contrast color
END IF
NEXT n%
ch% = ch% + 2 ' advance to next chord degree
IF ch% > 7 THEN ch% = ch% - 7 ' scale wrap around
NEXT triad%
END SUB 'Chord
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ CLEAR MOUSEBUTTON BUFFER
SUB Clear_MB (var AS INTEGER)
DO UNTIL NOT _MOUSEBUTTON(var)
_LIMIT 30
WHILE _MOUSEINPUT: WEND
LOOP
END SUB 'Clear_MB
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ CREATE CONTROL BLOCK
SUB CtrlBlk (b AS button)
DIM xsiz%, ysiz%, dst&, x%, sx, sy, p%
xsiz% = b.r.lr.x - b.r.ul.x + 1
ysiz% = b.r.lr.y - b.r.ul.y + 1
dst& = _DEST ' save calling destination
b.hn = _NEWIMAGE(xsiz%, ysiz%, 32)
_DEST b.hn
COLOR , b.c
CLS
BevelB xsiz%, ysiz%, b.c
_PRINTMODE _KEEPBACKGROUND
x% = LEN(_TRIM$(b.l))
sx = xsiz% / 2 - x% * 4: sy = ysiz% / 2 - 8
FOR p% = 1 TO x% ' iterate through label characters
COLOR -4294901760 * (p% = b.h) - 4278190080 * (p% <> b.h) '&HFFFF0000 &HFF000000
IF b.c = &HFFC80000 THEN COLOR &HFFFFFFFF
_PRINTSTRING (sx + (p% - 1) * 8, sy), MID$(_TRIM$(b.l), p%, 1)
NEXT p%
_DEST dst&
END SUB 'CtrlBlk
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ SET DEFAULT COLORS
SUB Default_Color (x%)
SELECT CASE x% - 38
CASE 0: bt(x%).c = Blue
CASE 1: bt(x%).c = Green
CASE 2: bt(x%).c = Red
CASE 3: bt(x%).c = Purple
CASE 4: bt(x%).c = Aqua
CASE 5: bt(x%).c = Orange
CASE 6: bt(x%).c = Yellow
CASE 7: bt(x%).c = Coral
CASE 8: bt(x%).c = Cerulean
CASE 9: bt(x%).c = Lime
CASE 10: bt(x%).c = Teal
CASE 11: bt(x%).c = Timberwolf
END SELECT
END SUB 'Default_Color
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ PIE CHART DIVIDE SPOTS
SUB Divisions (x%, y%, r%, div%, col&)
DIM div!, ang!
IF div% = 1 THEN EXIT SUB
div! = _PI(2) / div% ' radians per division
DO
ang! = ang! + div!
LINE (x%, y%)-(x% + COS(ang!) * r%, y% + SIN(ang!) * r%), Negative~&(col&) 'White
LOOP UNTIL ang! >= _PI(2)
END SUB 'Divisions
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ SET AND DISPLAY FRETBOARD EDGE DOTS
SUB DotFret
DIM fw%, fw1%, fw2%, fw3%, x%, y%, r%
fw% = Fret_Wide%
fw1% = _SHR(fw%, 2) ' 1/4 fret width
fw2% = _SHR(fw%, 1) ' 1/2 fret width
fw3% = fw1% * 3 ' 3/4 fret width
y% = neckdown% + _HEIGHT(fb&) + ((capotop% - (neckdown% + _HEIGHT(fb&))) / 2)
r% = .1875 * (capotop% - (neckdown% + _HEIGHT(fb&)))
FOR x% = 3 TO fretmax%
SELECT CASE x%
CASE 3, 5, 7, 9, 15, 17, 19, 21 ' single dot positions
FCirc nut% + x% * fw% - fw2%, y%, r%, White
CASE 12, 24 ' double dot positions
FCirc nut% + x% * fw% - fw1%, y%, r%, White
FCirc nut% + x% * fw% - fw3%, y%, r%, White
END SELECT
NEXT x%
END SUB 'DotFret
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ INITIAL STRING NOTE VALUES
SUB Init_Strings (fm AS INTEGER)
DIM n%, s%, f%
n% = 33 ' Initialize strings to standard tuning
FOR s% = 0 TO 5 ' Strings 0 through 5 (eBGDAE)
n% = n% + 4 * (s% = 2) + 5 * (s% <> 2) ' 4 frets on G (maj 3rd), 5 frets all others (perf 4th)
frets(s%, 25) = n% ' base note of standard tuning
frets(s%, 0) = frets(s%, 25) ' open note of string s%
FOR f% = 1 TO fm
frets(s%, f%) = frets(s%, 0) + f% ' populate fret notes
NEXT f%
NEXT s%
END SUB 'Init_Strings
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ DRAW FILLED CIRCLES
SUB FCirc (CX AS LONG, CY AS LONG, RR AS LONG, C AS _UNSIGNED LONG) 'by Steve McNeill
DIM AS LONG R, RError, X, Y
R = ABS(RR) ' radius value along positive x
RError = -R ' opposite side of circle? negative x
X = R ' point along positive x position
Y = 0 ' starting at the equator
IF R = 0 THEN PSET (CX, CY), C: EXIT SUB ' zero radius is point, not circle
LINE (CX - X, CY)-(CX + X, CY), C, BF ' draw equatorial line
WHILE X > Y
RError = RError + Y * 2 + 1
IF RError >= 0 THEN
IF X <> Y + 1 THEN
LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF ' draw line above equator
LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF ' draw line below equator
END IF
X = X - 1
RError = RError - X * 2
END IF
Y = Y + 1
LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF ' draw line north latitudes
LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF ' draw line south latitudes
WEND
END SUB 'FCirc
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ CREATE FRETBOARD IMAGE
SUB Fret_Board
DIM fr_rng%, fr_ps%, st_rng%, st_ps%, h%, fr%, st%
fr_rng% = Fret_Wide% ' fret range
h% = _HEIGHT(fb&)
_DEST fb&
CLS
LINE (nut%, 0)-(bridge%, h%), RawUmber, BF ' fretboard
LINE (nut% - 5, 0)-(nut% - 1, h%), Beige, BF ' nut
FOR fr% = 1 TO fretmax% ' frets
fr_ps% = nut% + fr_rng% * fr%
LINE (fr_ps%, 0)-(fr_ps% + 3, h%), PaleGoldenRod, BF
LINE (fr_ps% - 1, 0)-(fr_ps% - 1, h%), Black, BF
SELECT CASE fr% ' fretboard spots
CASE 3, 5, 7, 9, 15, 17, 19, 21
FCirc fr_ps% - _SHR(fr_rng%, 1), h% / 2, .05 * h%, BlueBell
CASE 12, 24
FCirc fr_ps% - _SHR(fr_rng%, 1), h% * (1 / 3), .05 * h%, BlueBell
FCirc fr_ps% - _SHR(fr_rng%, 1), h% * (2 / 3), .05 * h%, BlueBell
END SELECT
NEXT fr%
st_rng% = h% / 6
FOR st% = 0 TO 5 ' strings overlay
st_ps% = st_rng% * st% + (st_rng% / 2)
LINE (nut%, st_ps%)-(bridge%, st_ps% + (_CEIL((st% + 1) / 2))), Gold, BF
NEXT st%
_DEST 0
END SUB 'Fret_Board
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ WIDTH OF FRETS
FUNCTION Fret_Wide%
Fret_Wide% = (bridge% - nut%) / fretmax%
END FUNCTION 'Fret_Wide
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ FIT IMAGE TO DEFINED SPACE
SUB Image_Resize (xpos AS INTEGER, ypos AS INTEGER, xlim AS INTEGER, ylim AS INTEGER, i AS LONG, d AS LONG, xj AS STRING, yj AS STRING)
DIM AS INTEGER xs, ys, xp, yp, xl, yl ' ready for OPTION EXPLICIT programs
xp = xpos: yp = ypos: xl = xlim: yl = ylim ' isolate sent parameters from any changes
DIM AS SINGLE rt, xrt, yrt
xrt = (xl - xp) / _WIDTH(i) ' width of area divided by width of image
yrt = (yl - yp) / _HEIGHT(i) ' height of area divided by height of image
rt = -xrt * (xrt < yrt) - yrt * (yrt <= xrt) ' pick the smaller of the two ratios to fit area
xs = _WIDTH(i) * rt ' final image size ratio in x
ys = _HEIGHT(i) * rt ' final image size ratio in y
xp = -xp * (xj = "l") - (_SHR(xl - xp, 1) + xp - _SHR(xs, 1)) * (xj = "c") - (xl - xs) * (xj = "r")
xl = xp + xs
yp = -yp * (yj = "u") - (_SHR(yl - yp, 1) + yp - _SHR(ys, 1)) * (yj = "c") - (yl - ys) * (yj = "d")
yl = yp + ys
_PUTIMAGE (xp, yp)-(xl, yl), i, d
END SUB 'Image_Resize
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ BOOLEAN REGION DETECTION 1D
FUNCTION InRange% (var%, ll%, ul%) 'll% & ul% are order insensitive
InRange% = -((var% >= (-ll% * (ll% <= ul%) - ul% * (ll% > ul%))) * (var% <= (-ul% * (ll% <= ul%) - ll% * (ll% > ul%)))) 'in range? T/F
END FUNCTION 'InRange%
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ BOOLEAN REGION DETECTION 2D
FUNCTION InRegion% (p AS V2, r AS region)
InRegion% = -(InRange%(p.x, r.ul.x, r.lr.x) * InRange%(p.y, r.ul.y, r.lr.y)) 'in region? T/F
END FUNCTION 'InRegion%
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ DISPLAY SCALE INTERVALS
SUB Intervals
DIM I$25(12), D$14(8), x%, y%, d%, l%, dp%, hi&, lo&
I$25(0) = " root/tonic/unison": I$25(1) = " minor 2nd/semitone"
I$25(2) = " major 2nd/tone": I$25(3) = " minor 3rd"
I$25(4) = " major 3rd": I$25(5) = " perfect 4th"
I$25(6) = " aug 4/dim 5/tritone": I$25(7) = " perfect 5th/dominant"
I$25(8) = " minor 6th": I$25(9) = " major 6th"
I$25(10) = " minor 7th": I$25(11) = " major 7th": I$25(12) = " octave"
'D$14(1) = "I": D$14(2) = "II": D$14(3) = "III": D$14(4) = "IV"
'D$14(5) = "V": D$14(6) = "VI": D$14(7) = "VII": D$14(8) = "8'v"
D$14(1) = "I Tonic": D$14(2) = "II Supertonic": D$14(3) = "III Mediant": D$14(4) = "IV Subdominant"
D$14(5) = "V Dominant": D$14(6) = "VI Submediant": D$14(7) = "VII Leading": D$14(8) = "8'v Tonic"
hi& = sclcol
lo& = Gray
x% = bt(50).r.lr.x + 5
y% = bt(27).r.ul.y + 29
d% = 0
_PRINTSTRING (x%, y%), "LIST OF INTERVALS"
FOR l% = 0 TO 12 ' intervals unison thru octave
COLOR lo&
IF Vtog%(scale_on) THEN ' if scale chosen
IF l% = 12 THEN ' trap scale subscript error and set for octave
COLOR hi&: dp% = TRUE
d% = 8
ELSE
IF scale(l%) THEN
COLOR hi&: dp% = TRUE
d% = d% + 1
END IF
END IF
END IF
y% = y% + 16
_PRINTSTRING (x%, y%), I$25(l%) ' print interval name
_PRINTSTRING (x%, y%), _TRIM$(STR$(l%)) ' print interval number
IF dp% THEN
_PRINTSTRING (x% + 200, y%), "- " + D$14(d%) ' print scale degree
dp% = FALSE ' clear degree print
END IF
NEXT l%
COLOR White
END SUB 'Intervals
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ DRAW KEYBOARD AND SHOW CHOSEN NOTES
SUB Keyboard (kh%)
DIM kb&, p%, a%, a1%, d1%, ac%, ad%, p1%, fill&, ot&, x%
kb& = _NEWIMAGE(680, 100, 32) ' 34 white keys x 20
_DEST kb&
CLS , Ivory
DO 'first white keys (a%=0), then black (a%=-1) for proper overlay masking
p% = 0 ' key position- reset for each white/black run
a1% = -10 * (NOT a%) ' x offset of scale dots
d1% = 80 + 40 * a% ' base y displacement
ac% = -6 * a% ' accidentals offset (6 or 0)
ad% = _SHL(a1%, 1) ' right side +20 if not an accidental
FOR x% = 0 TO 56
p1% = p% * 20
IF a% = note(x%).ac THEN
fill& = -Black * a% - Ivory * (NOT a%) ' fill black keys with black and white keys with white
fill& = -fill& * (x% <> kh%) - Red * (x% = kh%) 'fill center mouse chosen key (if any) with red
LINE (p1% - ac%, 0)-(p1% + ac% + ad%, d1% + 20), fill&, BF 'fill key
LINE (p1% - ac%, 0)-(p1% + ac% + ad%, d1% + 20), Black, B 'outline key
IF note(x%).sd THEN '
FCirc p1% + a1%, d1%, 5, note(x%).c
IF a% THEN ot& = White ELSE ot& = Black
CIRCLE (p1% + a1%, d1%), 5, ot&
IF note(x%).sd = 1 THEN FCirc p1% + a1%, d1%, 2, White 'canter spot tonic note
END IF
IF x% = 12 THEN FCirc p% * 20 + 10, 97, 2, Black 'spot middle C
END IF
p% = p% - (NOT note(x%).ac) ' increment if not an accidental
NEXT x%
a% = a% - 1 ' decrement masking loop from white (0) to black (-1)
LOOP UNTIL a% < -1
_DEST 0
_PUTIMAGE (_WIDTH(0) - _WIDTH(kb&), scrh% * .41), kb&
_FREEIMAGE kb&
END SUB 'Keyboard
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ MAIN PROGRAM INPUT/DISPLAY JUNCTION
SUB MainLoop
DIM in%, done%, high%, singnt%, ntchs%, st%, fr%, x%, blk%, a%, ms
in% = TRUE: high% = 57 ' loop initial states
DO ' DISPLAY LOOP
DO ' INPUT LOOP
'key input
IF _KEYDOWN(8) THEN ' backspace' clear all
Note_Zero
_DELAY .2: in% = TRUE
END IF
IF _KEYDOWN(65) OR _KEYDOWN(97) THEN
Ttog all_nat ' a=all/naturals only
_DELAY .2: in% = TRUE
END IF
IF _KEYDOWN(66) OR _KEYDOWN(98) THEN
Ttog shrp_flt ' b=flat/sharp
_DELAY .2: in% = TRUE
END IF
IF _KEYDOWN(72) OR _KEYDOWN(104) THEN
Ttog hide_show ' h=hide/show notes
_DELAY .2: in% = TRUE
END IF
IF _KEYDOWN(75) OR _KEYDOWN(107) THEN
Ttog key_show ' k=hide/show keyboard
_DELAY .2: in% = TRUE
END IF
IF _KEYDOWN(83) OR _KEYDOWN(115) THEN
Ttog slnt_snd ' s=silent/sound
_DELAY .2: in% = TRUE
END IF
IF _KEYDOWN(81) OR _KEYDOWN(113) OR _KEYDOWN(27) THEN SYSTEM 'Quit
IF _KEYDOWN(19712) THEN ' forward arrow= increase fretboard
fretmax% = fretmax% - (fretmax% < 24)
Fret_Board
_DELAY .2
in% = TRUE
END IF
IF _KEYDOWN(19200) THEN ' back arrow= reduce fretboard
fretmax% = fretmax% + (fretmax% > 14)
Fret_Board
_DELAY .2: in% = TRUE
END IF
'mouse input
ms = MBS%
IF ms AND 1 THEN ' left mouse button press
Clear_MB 1
MB_Left mous
singnt% = 0: ntchs% = 0
in% = TRUE
END IF
IF ms AND 2 THEN ' right mouse button press
Clear_MB 2
MB_Right mous
singnt% = 0: ntchs% = 0
in% = TRUE
END IF
IF ms AND 4 THEN ' center/mousewheel button press on fretboard
IF InRegion%(mous, bt(19).r) THEN ' if on fretboard
st% = (mous.y - neckdown%) \ (_HEIGHT(fb&) / 6) 'string calc
fr% = INT((mous.x - nut%) / Fret_Wide%) + 1 'fret calc
IF fr% = 0 THEN a% = capo% ELSE a% = 0
high% = frets(st%, fr%) + a%
singnt% = TRUE: ntchs% = frets(st%, fr%) + a%
in% = TRUE
IF Vtog%(slnt_snd) THEN
SOUND note(frets(st%, fr%) + a%).hz, 18
END IF
END IF
Clear_MB 3
END IF
_LIMIT 30
LOOP UNTIL in% ' END: INPUT LOOP
in% = FALSE
CLS
'image refresh
_PUTIMAGE (0, neckdown%), fb&, 0 ' OVERLAY FRETBOARD
_PRINTSTRING (16, neckdown% - 20), "Tuners"
FOR x% = 0 TO 51 ' place buttons and toggles
IF x% > 17 AND x% < 21 THEN _CONTINUE ' skip capo track, fretboard & circle of fifths
ButPut x%
IF x% < 18 AND x% MOD 3 = 1 THEN ' if center tuner
IF frets(x% \ 3, 0) = frets(x% \ 3, 25) THEN
ButBlank x% ' blank if default tuned
ELSE
IF frets(x% \ 3, 0) > frets(x% \ 3, 25) THEN
RegionArrow bt(x%).r, "u", "half", &H6FFF0000 'tune arrow
ELSE
RegionArrow bt(x%).r, "d", "half", &H6FFF0000 'tune arrow
END IF
END IF
END IF
SELECT CASE x%
CASE 21 TO 27 ' Mode toggles
IF NOT Vtog%(x% - 21) THEN ButBlank x%
IF Vtog%(mode_lock) AND Vtog%(x% - 21) THEN
RegionRing bt(x%).r, Red, 3
END IF
CASE 28, 29 ' octave/single toggle
IF Vtog%(oct_sing) THEN blk% = 29 ELSE blk% = 28
IF x% = blk% THEN ButBlank x%
CASE 30, 31 ' all/natural toggle
IF Vtog%(all_nat) THEN blk% = 30 ELSE blk% = 31
IF x% = blk% THEN ButBlank x%
CASE 32, 33 ' show/hide notes toggle
IF Vtog%(hide_show) THEN blk% = 33 ELSE blk% = 32
IF x% = blk% THEN ButBlank x%
CASE 34, 35
IF Vtog%(shrp_flt) THEN blk% = 34 ELSE blk% = 35
IF x% = blk% THEN ButBlank x%
CASE 36, 37
IF Vtog%(slnt_snd) THEN blk% = 36 ELSE blk% = 37
IF x% = blk% THEN ButBlank x%
CASE 38 TO 49
IF defcol = bt(x%).c THEN ' negative border active color
RegionRing bt(x%).r, Negative~&(bt(x%).c), 6
END IF
CASE 50
IF NOT Vtog%(col_chg) THEN ButBlank x%
CASE 51
IF NOT Vtog%(key_show) THEN ButBlank x%
END SELECT
NEXT x%
SELECT EVERYCASE fretmax%
CASE 14 TO 23
RegionArrow bt(52).r, "r", "half", &H9FFF0000
CASE 15 TO 24
RegionArrow bt(52).r, "l", "half", &H9FFF0000
END SELECT
FOR x% = 53 TO 59
ButPut x%
IF NOT Vtog%(x% - 46) THEN ButBlank x%
NEXT x%
String_Notes
Stafftmp singnt%, note(ntchs%) '
_PUTIMAGE (scrw% * .75, scrh% * .6)-(scrw% - 1, scrh% - 1), sttmp& '
DotFret
Capo_Track
Limit_Track
Circle_of_Fifth
Intervals
NameChords
IF Vtog%(key_show) THEN Keyboard high%: high% = 57 '
_PRINTSTRING (0, _HEIGHT(0) - 64), "clockwise:"
_PRINTSTRING (0, _HEIGHT(0) - 48), "Father Charles Goes Down And Ends Battle"
_PRINTSTRING (0, _HEIGHT(0) - 32), "counter clockwise:"
_PRINTSTRING (0, _HEIGHT(0) - 16), "Battle Ends And Down Goes Charles Father"
'_PRINTSTRING (0, 0), aspect$
_DISPLAY
LOOP UNTIL done% ' END: DISPLAY LOOP
END SUB 'MainLoop
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ CREATE CONTROL BUTTONS & REGIONS
SUB Make_Buttons
DIM sz%, x%, xp%, y%, yp%, b%, ul%, f&, colorfile%, ho%, vo%
sz% = ((_HEIGHT(fb&) - 1) / 6) * .75 ' Tuners
FOR y% = 0 TO 5 ' iterating string tiers
yp% = neckdown% + y% * ((_HEIGHT(fb&) - 1) / 6) + sz% / 3
FOR x% = 0 TO 2
xp% = sz% / 2 + x% * sz% * 1.25
b% = x% + y% * 3
bt(b%).l = _TRIM$(MID$("-|+", x% + 1, 1))
bt(b%).r.ul.x = xp%
bt(b%).r.ul.y = yp%
bt(b%).r.lr.x = xp% + sz%
bt(b%).r.lr.y = yp% + sz%
bt(b%).c = &HFF00FF00
bt(b%).h = 0
CtrlBlk bt(b%)
NEXT x%
NEXT y%
bt(18).r.ul.x = nut% - Fret_Wide% '-------------------------capo track region
bt(18).r.ul.y = capotop%
bt(18).r.lr.x = bridge%
bt(18).r.lr.y = capobot%
bt(19).r.ul.x = bt(18).r.ul.x '-----------------------------fretboard region
bt(19).r.ul.y = neckdown%
bt(19).r.lr.x = bridge%
bt(19).r.lr.y = neckdown% + _HEIGHT(fb&) - 1
bt(20).r.ul.x = 0 '-----------------------------------------circle of fifths region
bt(20).r.ul.y = scrh% * .42
bt(20).r.lr.x = _HEIGHT(0) - scrh% * .5
bt(20).r.lr.y = bt(20).r.ul.y + bt(20).r.lr.x
FOR x% = 21 TO 27 '-----------------------------------------SCALES
bt(x%).r.ul.x = bt(20).r.lr.x + 1
bt(x%).r.ul.y = bt(20).r.ul.y + (24 * (x% - 21))
bt(x%).r.lr.x = bt(x%).r.ul.x + 128
bt(x%).r.lr.y = bt(x%).r.ul.y + 24
bt(x%).c = &HFF00FF00
SELECT CASE x%
CASE 21: bt(x%).l = "Ionian/Major"
CASE 22: bt(x%).l = "Dorian"
CASE 23: bt(x%).l = "Phrygian"
CASE 24: bt(x%).l = "Lydian"
CASE 25: bt(x%).l = "Mixolydian"
CASE 26: bt(x%).l = "Aeolian/Minor"
CASE 27: bt(x%).l = "Locrian"
END SELECT
CtrlBlk bt(x%)
NEXT x%
FOR x% = 28 TO 37 '-----------------------------------------TOP TOGGLES
IF x% = 28 THEN
ul% = nut%
ELSE
ul% = bt(x% - 1).r.lr.x - (x% MOD 2 <> 0) - (scrw% * .02) * (x% MOD 2 = 0)
END IF
bt(x%).r.ul.x = ul%
bt(x%).r.ul.y = scrh% * .007 'togtop%
bt(x%).r.lr.x = bt(x%).r.ul.x + 63
bt(x%).r.lr.y = scrh% * 0.04 'togbot%
SELECT CASE x%
CASE 28: bt(x%).l = "Octave"
CASE 29: bt(x%).l = "Single"
CASE 30: bt(x%).l = "All": bt(x%).h = 1
CASE 31: bt(x%).l = "Natural": bt(x%).h = 2
CASE 32: bt(x%).l = "Show": bt(x%).h = 2
CASE 33: bt(x%).l = "Hide": bt(x%).h = 1
CASE 34: bt(x%).l = "Sharp"
CASE 35: bt(x%).l = "Flat"
CASE 36: bt(x%).l = "Silent": bt(x%).h = 1
CASE 37: bt(x%).l = "Sound": bt(x%).h = 1
END SELECT
bt(x%).c = &HFF00FF00
CtrlBlk bt(x%)
NEXT x%
IF _FILEEXISTS("notecolor.ini") THEN
f& = FREEFILE
OPEN "notecolor.ini" FOR BINARY AS f&
colorfile% = TRUE
ELSE
colorfile% = FALSE
END IF
FOR x% = 38 TO 49 '-----------------------------------------Twelve 42 x 42 color buttons
ho% = (x% - 38) MOD 3
vo% = (x% - 38) \ 3
bt(x%).r.ul.x = bt(20).r.lr.x + 1 + (42 * ho%)
bt(x%).r.ul.y = bt(27).r.ul.y + 29 + (42 * vo%)
bt(x%).r.lr.x = bt(x%).r.ul.x + 42
bt(x%).r.lr.y = bt(x%).r.ul.y + 42
IF colorfile% THEN
GET f&, , bt(x%).c
ELSE
Default_Color x%
END IF
CtrlBlk bt(x%)
NEXT x%
CLOSE f&
bt(50).r.ul.x = bt(20).r.lr.x + 1 ' color save
bt(50).r.ul.y = bt(49).r.lr.y + 5
bt(50).r.lr.x = bt(50).r.ul.x + 128
bt(50).r.lr.y = bt(50).r.ul.y + 36
bt(50).c = &HFF00FF00
bt(50).l = "Save colors"
CtrlBlk bt(50)
bt(51).r.ul.x = bt(37).r.lr.x + (scrw% * .02) '-------------Keyboard
bt(51).r.ul.y = scrh% * .007 'togtop% 'bt(37).r.ul.y
bt(51).r.lr.x = bt(51).r.ul.x + 96
bt(51).r.lr.y = scrh% * 0.04 'togbot% 'bt(51).r.ul.y + 23
bt(51).c = &HFF00FF00
bt(51).h = 1
bt(51).l = "Keyboard"
CtrlBlk bt(51)
bt(52).r.ul.x = scrw% * .96 '-------------------------------Fret Size Control
bt(52).r.ul.y = neckdown%
bt(52).r.lr.x = scrw% * .99
bt(52).r.lr.y = neckdown% + _HEIGHT(fb&)
FOR x% = 53 TO 59 '-----------------------------------------Chord controls
bt(x%).r.ul.x = bt(x% - 32).r.lr.x + 5
bt(x%).r.ul.y = bt(x% - 32).r.ul.y
bt(x%).r.lr.x = bt(x%).r.ul.x + 96
bt(x%).r.lr.y = bt(x%).r.ul.y + 24
bt(x%).c = &HFF00FF00
SELECT CASE x%
CASE 53: bt(x%).l = "I"
CASE 54: bt(x%).l = "II"
CASE 55: bt(x%).l = "III"
CASE 56: bt(x%).l = "IV"
CASE 57: bt(x%).l = "V"
CASE 58: bt(x%).l = "VI"
CASE 59: bt(x%).l = "VII"
END SELECT
CtrlBlk bt(x%)
NEXT x%
_DEST 0
END SUB 'Make_Buttons
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ LEFT MOUSE BUTTON OPS
SUB MB_Left (ps AS V2)
DIM x%, valid%, s%, f%, st%, fr%, ang%, in%, t%, b%, rotar%, f&, c%
FOR x% = 0 TO 59
IF InRegion%(ps, bt(x%).r) THEN
valid% = TRUE: EXIT FOR
END IF
NEXT x%
IF NOT valid% THEN EXIT SUB
SELECT CASE x%
CASE 0 TO 17 ' TUNER REGIONS
IF x% MOD 3 = 0 THEN ' Detune
frets(x% \ 3, 0) = frets(x% \ 3, 0) + (frets(x% \ 3, 0) > 0)
ELSEIF x% MOD 3 = 1 THEN ' Base tuning
frets(x% \ 3, 0) = frets(x% \ 3, 25)
ELSEIF x% MOD 3 = 2 THEN ' Uptune
frets(x% \ 3, 0) = frets(x% \ 3, 0) - (frets(x% \ 3, 24) < 56)
END IF
FOR s% = 0 TO 5 ' re-tune strings
FOR f% = 1 TO 24
frets(s%, f%) = frets(s%, 0) + f%
NEXT f%
NEXT s%
CASE 18
capo% = _CEIL((ps.x - nut%) / Fret_Wide%)
IF capo% < 0 THEN capo% = 0
CASE 19 ' FRETBOARD REGION
st% = (ps.y - neckdown%) \ (_HEIGHT(fb&) / 6) ' string calc
fr% = INT((ps.x - nut%) / Fret_Wide%) + 1 ' fret calc
SearchNote -1, note(frets(st%, fr%))
CASE 20 ' CIRCLE OF FIFTHS REGION
DIM AS V2 cen, clk
DIM k(11) AS tone
DIM dst!
SetNote k()
CentRg cen, bt(20).r ' center of circle of fifths
clk = mous: R2_Add clk, cen, -1 ' clk relative to circle center
dst! = _HYPOT(clk.x, clk.y)
IF dst! < cen.x * .3 THEN ' within clear all circle
Note_Zero
ELSE
IF dst! > cen.x * inring AND dst! < cen.x * outring THEN 'within note ring
IF Vtog%(scale_on) THEN Note_Zero ' clear all for new scale
ang% = _R2D(_ATAN2(clk.y, clk.x) - .261799) 'get angle of mouse click _PI / 12 = .261799
IF SGN(ang%) < 0 THEN
ang% = ABS(ang%) \ 30
ELSE
ang% = (360 - ang%) \ 30 ' was: ang% = (180 + (180 - ang%)) \ 30
END IF
in% = 9
DO UNTIL ang% = 0
in% = Pfifth%(in%, 5)
ang% = ang% - 1
LOOP
Stog scale_on ' set scale mode
FOR x% = 0 TO 6 ' check all modal states
t% = t% + Vtog%(x%)
NEXT x%
IF t% = 0 THEN Stog 0 ' if no state set default to Ionian/Major
tonic = k(in%) ' set tonic ID
Signature in% ' adjust sharp/flat to appropriate key
Scale_Run ' construct scale note pointers
END IF
END IF
CASE 21 TO 27 ' SCALE MODES
ResetScale ' set back to Ionian scale
Note_Zero ' clear all note selections
FOR b% = 21 TO 27
IF b% = x% THEN
Ttog b% - 21 ' toggle selected bit on/off
ELSE
Rtog b% - 21 ' clear all non-selected bits
END IF
NEXT b%
SELECT CASE x% ' determine scale rotation factor - use shortest
CASE 21: rotar% = 0 ' ionian 0
CASE 22: rotar% = -2 ' dorian -2 10
CASE 23: rotar% = -4 ' phrygian -4 8
CASE 24: rotar% = -5 ' lydian -5 7
CASE 25: rotar% = 5 ' mixolydian -7 5
CASE 26: rotar% = 3 ' aeolian -9 3
CASE 27: rotar% = 1 ' locrian -11 1
END SELECT
RotArrayM scale(), rotar% ' rotate to mode from Ionian
CASE 28, 29 ' SINGLE/OCTAVE TOGGLE
Ttog oct_sing
CASE 30, 31
Ttog all_nat
CASE 32, 33
Ttog hide_show
CASE 34, 35
Ttog shrp_flt
CASE 36, 37
Ttog slnt_snd
CASE 38 TO 49
defcol = bt(x%).c ' default color
CASE 50
IF Vtog%(col_chg) THEN
IF _FILEEXISTS("notecolor.ini") THEN
KILL "notecolor.ini"
END IF
f& = FREEFILE
OPEN "notecolor.ini" FOR BINARY AS f&
FOR c% = 38 TO 49
PUT f&, , bt(c%).c
NEXT c%
CLOSE f&
Rtog col_chg
END IF
CASE 51 ' SHOW/HIDE KEYBOARD
Ttog key_show
CASE 52 ' INCREMENT/DECREMENT FRET COUNT
IF ps.x < MidPt%(bt(52).r.ul.x, bt(52).r.lr.x) THEN
fretmax% = fretmax% + (fretmax% > 14)
Fret_Board
ELSE
fretmax% = fretmax% - (fretmax% < 24)
Fret_Board
END IF
CASE 53 TO 59 ' CHORD BUTTONS
FOR t% = 7 TO 13
Rtog t%
NEXT t%
IF Vtog%(scale_on) THEN
UnChord
Stog chordset
Stog x% - 46
Chord x% - 52
END IF
CASE ELSE
END SELECT
END SUB 'MB_Left
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ RIGHT BUTTON MOUSE OPS
SUB MB_Right (ps AS V2)
DIM x%, valid%, st%, fr%, a%, pk%, srch%, ncolor&, m&
FOR x% = 0 TO 50
IF InRegion%(ps, bt(x%).r) THEN
valid% = TRUE: EXIT FOR
END IF
NEXT x%
IF NOT valid% THEN EXIT SUB
SELECT CASE x%
CASE 18
frlimit% = _CEIL((ps.x - nut%) / Fret_Wide%) - 1
IF frlimit% > fretmax% THEN frlimit% = 0
IF frlimit% < 0 THEN frlimit% = 0
CASE 19
st% = (ps.y - neckdown%) \ (_HEIGHT(fb&) / 6) ' string calc
fr% = INT((ps.x - nut%) / Fret_Wide%) + 1 ' fret calc
IF fr% = 0 THEN a% = capo% ELSE a% = 0 ' fret 0 alteration
SearchNote 0, note(frets(st%, fr%))
pk% = FALSE
FOR srch% = 0 TO 56 ' check for still picked notes
IF note(srch%).sd <> 0 THEN pk% = TRUE
NEXT srch%
IF NOT pk% THEN ' if none left then clear picked and scale modes
Rtog scale_on
Rtog picked
END IF
CASE 21 TO 27 ' MODE BUTTONS
Ttog mode_lock ' right click to lock in mode
CASE 38 TO 49 ' Color buttons
ncolor& = _COLORCHOOSERDIALOG("", 0)
IF ncolor& <> 0 THEN bt(x%).c = ncolor&
_DEST bt(x%).hn
CLS
CtrlBlk bt(x%)
Stog col_chg
_DEST 0
CASE 50 'right click on save button to restore default colors
m& = _MESSAGEBOX("Restore Default Colors", "Are you sure you wish to restore defualts?", "okcancel", "warning", 0)
IF m& THEN
FOR x% = 38 TO 49 ' Twelve 42 x 42 color buttons
Default_Color x%
_DEST bt(x%).hn
CLS
CtrlBlk bt(x%)
NEXT x%
_DEST 0
Stog col_chg
END IF
END SELECT
END SUB 'MB_Right
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ MOUSE BUTTON STATUS
FUNCTION MBS% 'Mouse Button Status by Steve McNeill
DIM tempMBS ', Mouse_StartX, Mouse_StartY, Mouse_EndX, Mouse_EndY
WHILE _MOUSEINPUT 'Remark out this block, if mouse main input/clear is going to be handled manually in main program.
SELECT CASE SGN(_MOUSEWHEEL)
CASE 1: tempMBS = tempMBS OR 512
CASE -1: tempMBS = tempMBS OR 1024
END SELECT
WEND
mous.x = _MOUSEX
mous.y = _MOUSEY
IF _MOUSEBUTTON(1) THEN tempMBS = tempMBS OR 1
IF _MOUSEBUTTON(2) THEN tempMBS = tempMBS OR 2
IF _MOUSEBUTTON(3) THEN tempMBS = tempMBS OR 4
MBS% = tempMBS
END FUNCTION 'MBS%
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ
SUB CentRg (re AS V2, send AS region)
re.x = MidPt%(send.ul.x, send.lr.x)
re.y = MidPt%(send.ul.y, send.lr.y)
END SUB 'CentRg
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ MIDDLE POINT BETWEEN TWO INTEGERS
FUNCTION MidPt% (start AS INTEGER, finish AS INTEGER)
MidPt% = start + _SHR((finish - start), 1)
END FUNCTION 'MidPt%
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ DISPLAY CHORD NAMES
SUB NameChords
DIM cn%, nt%, tri%, subtri%, n%, chrdnm$, third%, interval%, fifth%
IF Vtog%(scale_on) THEN
FOR cn% = 1 TO 7
nt% = 0
FOR tri% = cn% TO cn% + 4 STEP 2
subtri% = -(tri% - 7) * (tri% > 7) - (tri%) * (tri% <= 7)
FOR n% = nt% TO 56
SELECT CASE tri%
CASE cn%
IF note(n%).sd = subtri% THEN
chrdnm$ = _TRIM$(note(n% + 12).ft)
nt% = n%
EXIT FOR
END IF
CASE cn% + 2
IF note(n%).sd = subtri% THEN
third% = interval%
interval% = 0
nt% = n%
EXIT FOR
END IF
interval% = interval% + 1
CASE cn% + 4
IF note(n%).sd = subtri% THEN
fifth% = interval%
interval% = 0
EXIT FOR
END IF
interval% = interval% + 1
END SELECT
NEXT n%
NEXT tri%
IF third% = 4 THEN
chrdnm$ = chrdnm$ + "maj"
ELSEIF third% = 3 THEN
chrdnm$ = chrdnm$ + "min"
IF fifth% = 3 THEN chrdnm$ = chrdnm$ + CHR$(248)
END IF
_PRINTSTRING (bt(cn% + 52).r.lr.x + 2, bt(cn% + 52).r.ul.y + 4), chrdnm$
chrdnm$ = ""
NEXT cn%
END IF
END SUB 'NameChords
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ COLOR NEGATIVE
FUNCTION Negative~& (c AS _UNSIGNED LONG)
Negative~& = _RGBA32(127 - (_RED(c) - 127), 127 - (_GREEN(c) - 127), 127 - (_BLUE(c) - 127), _ALPHA(c))
END FUNCTION 'Negative~&
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ GET A NOTE NAME IN CONTEXT OF SHARP/FLAT
FUNCTION NoteName$ (n AS tone)
IF n.ac THEN ' If note enharmonic
IF Vtog%(shrp_flt) THEN ' If in flat mode
NoteName$ = n.bf
ELSE ' If in sharp mode
NoteName$ = n.bs
END IF
ELSE ' If note NOT enharmonic
NoteName$ = n.nt
END IF
END FUNCTION 'NoteName$
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ RETURN ARRAY POSITION OF A TARGET TONE
FUNCTION NotePosition% (arr() AS tone, tar AS tone)
DIM ft$, gt$, x%
ft$ = tar.nt + tar.bf + tar.bs
DO
gt$ = arr(x%).nt + arr(x%).bf + arr(x%).bs
IF ft$ = gt$ THEN
NotePosition% = x%: EXIT FUNCTION
END IF
x% = x% + 1
LOOP UNTIL x% = UBOUND(arr) + 1
END FUNCTION 'NotePosition
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ CLEAR ALL NOTE PICKS
SUB Note_Zero
DIM s%, x%, c%
Rtog picked ' no notes picked
Rtog scale_on ' scale absent
Rtog chordset ' no chords selected
FOR s% = 7 TO 13
Rtog s%
NEXT s%
IF NOT Vtog%(mode_lock) THEN ' if not scale locked
ResetScale ' reset to Ionian
FOR x% = 0 TO 6
IF Vtog%(x%) THEN Ttog x% ' clear all scale ID bits
NEXT x%
Stog 0 ' Reset to Ionian scale
END IF
tonic.nt = "" ' blank tonic note
tonic.bs = ""
tonic.bf = ""
FOR c% = 0 TO 56 ' blank all note choices
note(c%).sd = 0
note(c%).c = 0
note(c%).ft = NoteName(note(c%))
NEXT c%
END SUB 'Note_Zero
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ MOVE BY INTERVAL {ad}
FUNCTION Pfifth% (v AS INTEGER, ad AS INTEGER)
DIM v1
v1 = v + ad
Pfifth% = v1 + 12 * (v1 >= 12) - 12 * (v1 < 0)
END FUNCTION 'Pfifth%
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ ARROW INDICATOR
SUB RegionArrow (r AS region, ori AS STRING, fill AS STRING, col AS _UNSIGNED LONG)
DIM c&
DIM AS V2 pt, pl, pr, m
c& = _NEWIMAGE(1, 1, 32)
_DEST c&
CLS , col
_DEST 0
CentRg m, r
SELECT CASE LCASE$(ori)
CASE "u" ' Arrow UP
IF fill = "full" THEN m.y = r.lr.y
pt.x = m.x: pt.y = r.ul.y
pl.x = r.ul.x: pl.y = m.y
pr.x = r.lr.x: pr.y = m.y
CASE "r" ' Arrow RIGHT
IF fill = "full" THEN m.x = r.ul.x
pt.x = r.lr.x: pt.y = m.y
pl.x = m.x: pl.y = r.ul.y
pr.x = m.x: pr.y = r.lr.y
CASE "d" ' Arrow DOWN
IF fill = "full" THEN m.y = r.ul.y
pt.x = m.x: pt.y = r.lr.y
pl.x = r.lr.x: pl.y = m.y
pr.x = r.ul.x: pr.y = m.y
CASE "l" ' Arrow LEFT
IF fill = "full" THEN m.x = r.lr.x
pt.x = r.ul.x: pt.y = m.y
pl.x = m.x: pl.y = r.lr.y
pr.x = m.x: pr.y = r.ul.y
END SELECT
_MAPTRIANGLE (0, 0)-(0, 0)-(0, 0), c& TO(pl.x, pl.y)-(pt.x, pt.y)-(pr.x, pr.y)
_FREEIMAGE c&
END SUB 'RegionArrow
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ HIGHLIGHT BUTTON EDGE
SUB RegionRing (r AS region, col AS _UNSIGNED LONG, t AS INTEGER)
DIM b%, c%, clr&
b% = t \ 3
FOR c% = 0 TO t - 1
IF c% < b% OR c% = t - 1 THEN clr& = Black ELSE clr& = col
LINE (r.ul.x + c%, r.ul.y + c%)-(r.lr.x - c%, r.lr.y - c%), clr&, B
NEXT c%
END SUB 'RegionRing
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ RESET TO IONIAN/MAJOR SCALE
SUB ResetScale
$CHECKING:OFF
DIM AS _MEM m, s
m = _MEM(masterscale())
s = _MEM(scale())
_MEMCOPY m, m.OFFSET, m.SIZE TO s, s.OFFSET
_MEMFREE m: _MEMFREE s
$CHECKING:ON
END SUB 'ResetScale
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ RESET TOGS BIT b
SUB Rtog (b AS INTEGER)
togs = _RESETBIT(togs, b)
END SUB 'Rtog
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ SET TOGS BIT b
SUB Stog (b AS INTEGER)
togs = _SETBIT(togs, b)
END SUB 'Stog
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ TOGGLE TOGS BIT b
SUB Ttog (b AS INTEGER)
togs = _TOGGLEBIT(togs, b)
END SUB 'Ttog
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ VIEW TOGS BIT b
FUNCTION Vtog% (b AS INTEGER)
Vtog% = _READBIT(togs, b)
END FUNCTION 'Vtog%
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ ROTATE SCALE ARRAYS {MEM BASED}
SUB RotArrayM (arr() AS _BYTE, rt%)
DIM cr1%, cr2%, bl%&, sr%&, sl%&
IF rt% = 0 THEN EXIT SUB
cr1% = ABS(rt%): cr2% = 0
$CHECKING:OFF
DIM AS _MEM ar, t
ar = _MEM(arr()): t = _MEMNEW(cr1%)
bl%& = ar.SIZE - cr1%
sr%& = -(rt% > 0) * bl%& ' Rotate right=TRUE rotate left=FALSE {start right}
sl%& = -(rt% < 0) * bl%& ' Rotate right=FALSE rotate left=TRUE {start left}
_MEMCOPY ar, ar.OFFSET + sr%&, cr1% TO t, t.OFFSET ' pop right or left rt% bytes to temp storage
IF sr%& = 0 THEN SWAP cr1%, cr2% ' if left shift swap offsets
_MEMCOPY ar, ar.OFFSET + cr2%, bl%& TO ar, ar.OFFSET + cr1% 'shift remainder block right or left {if swapped}
IF sr%& = 0 THEN SWAP cr1%, cr2% ' if left shift re-swap offsets
_MEMCOPY t, t.OFFSET, cr1% TO ar, ar.OFFSET + sl%& ' push temp storage to opposite end from pop
_MEMFREE ar: _MEMFREE t
$CHECKING:ON
END SUB 'RotArrayM
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ CREATE NOTE SCALE
SUB Scale_Run
DIM d%, x%, p%, n%
DIM sc(11) AS _BYTE ' local scale array
DIM AS _MEM sg, sl
sg = _MEM(scale()): sl = _MEM(sc())
_MEMCOPY sg, sg.OFFSET, sg.SIZE TO sl, sl.OFFSET ' copy from global scale
_MEMFREE sg: _MEMFREE sl
sclcol = defcol
d% = 1 ' set initial degree counter to tonic
FOR x% = 0 TO 11 ' populate scale array with scale degrees {1-7} & index tonic
IF sc(x%) THEN sc(x%) = d%: d% = d% + 1 ' set scale degree & increment to next; supertonic, mediant, etc.
NEXT x%
RotArrayM sc(), NotePosition%(note(), tonic) ' rotate the local scale to align with tonic in note array
p% = 0
FOR n% = 0 TO 56 ' distribute local array across note array
IF sc(p%) THEN
note(n%).sd = sc(p%) ' set note scale degree
note(n%).c = sclcol ' and color
Stog picked ' set picked note TRUE
END IF
p% = p% + 1 ' advance scale with note array loop
IF p% = 12 THEN p% = 0 ' reset scale if beyond upper bound
NEXT n%
END SUB 'Scale_Run
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ SEARCH FOR MATCHING TONE SINGLY OR ALL OCTAVES
SUB SearchNote (mode AS INTEGER, t AS tone)
DIM s%
IF Vtog(oct_sing) THEN ' search all octave examples
s% = NotePosition%(note(), t) '
DO
IF mode THEN ' mode: add note = TRUE
IF note(s%).sd = 0 THEN note(s%).sd = TRUE ' only set if not in a scale (keep scale degrees)
note(s%).c = defcol ' change color regardless
Stog picked
ELSE ' mode: remove note = FALSE
note(s%).sd = FALSE ' clear this note
note(s%).c = 0 ' and reset its color
END IF
s% = s% + 12 ' jump to next octave
LOOP UNTIL s% > 56
ELSE ' search only matching octave
IF mode THEN
IF t.sd = 0 THEN t.sd = TRUE
t.c = defcol
Stog picked
ELSE
t.sd = FALSE
t.c = 0
END IF
END IF
END SUB 'SearchNote
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ CREATE CHROMATIC TONE ARRAY
SUB SetNote (q() AS tone)
DIM nt$, x%, deg%, ni%, H!, c%
DIM AS SINGLE Hz(11) ' base cycle array
Hz(0) = 32.7: Hz(1) = 34.65: Hz(2) = 36.71 ' C, C#, D
Hz(3) = 38.9: Hz(4) = 41.2: Hz(5) = 43.65 ' D#, E, F
Hz(6) = 46.25: Hz(7) = 49: Hz(8) = 51.91 ' F#, G, G#
Hz(9) = 55: Hz(10) = 58.27: Hz(11) = 61.74 ' A, A#, B
nt$ = "CDEFGAB" ' cardinal note string
FOR x% = 0 TO UBOUND(q) ' iterate full tone array
deg% = x% MOD 12 ' compute chromatic degree from C=0
SELECT EVERYCASE deg%
CASE 0, 2, 4, 5, 7, 9, 11 ' white key cardinal notes {C D E F G A B}
ni% = ni% + 1 ' increment note name index
IF ni% = 8 THEN ni% = 1 ' keep index in 1-7 range
q(x%).nt = MID$(nt$, ni%, 1) ' set natural note name
q(x%).ac = FALSE ' note is not an accidental
H! = Hz(deg%)
CASE 4, 11 ' E, B flats
c% = -(deg% = 11) - (ni% + 1) * (deg% = 4) ' B(11) sets a 1 : E(4) sets to next name index
q(x%).bf = MID$(nt$, c%, 1) + "b"
CASE 0, 5 ' C, F sharps
c% = -7 * (deg% = 0) - (ni% - 1) * (deg% = 5) ' C(0) sets last name index : F(5) sets previous index
q(x%).bs = MID$(nt$, c%, 1) + "#"
CASE 1, 3, 6, 8, 10 ' black key accidental notes {C# D# F# G# A#}
q(x%).nt = "*"
q(x%).bs = MID$(nt$, ni%, 1) + "#" ' sharp name
q(x%).bf = MID$(nt$, ni% + 1, 1) + "b" ' flat name
q(x%).ac = TRUE ' note is an accidental
H! = Hz(deg%)
END SELECT
q(x%).oc = x% \ 12 + 1
q(x%).hz = CINT(H! * (2 ^ q(x%).oc)) ' calculate tone cycles
q(x%).indx = x%
NEXT x%
END SUB 'SetNote
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ SELECT SHARP/FLAT KEY BIAS
SUB Signature (k%)
DIM x%
FOR x% = 0 TO 6
IF Vtog(x%) THEN EXIT FOR
NEXT x%
SELECT CASE x%
CASE 0:
SELECT CASE k% ' Ionian/Major
CASE 1, 3, 5, 6, 8, 10: Stog shrp_flt
CASE 0, 2, 4, 7, 9, 11: Rtog shrp_flt
END SELECT
CASE 1:
SELECT CASE k% ' Dorian
CASE 0, 1, 3, 5, 7, 8, 10: Stog shrp_flt
CASE 2, 4, 6, 9, 11: Rtog shrp_flt
END SELECT
CASE 2:
SELECT CASE k% ' Phrygian
CASE 0, 2, 3, 5, 7, 9, 10: Stog shrp_flt
CASE 1, 4, 6, 8, 11: Rtog shrp_flt
END SELECT
CASE 3:
SELECT CASE k% ' Lydian
CASE 1, 3, 6, 8, 10, 11: Stog shrp_flt
CASE 0, 2, 4, 5, 7, 9: Rtog shrp_flt
END SELECT
CASE 4:
SELECT CASE k% ' Mixolydian
CASE 0, 1, 3, 5, 6, 8, 10: Stog shrp_flt
CASE 2, 4, 7, 9, 11: Rtog shrp_flt
END SELECT
CASE 5:
SELECT CASE k% ' Aeolian/Minor
CASE 0, 2, 3, 5, 7, 8, 10: Stog shrp_flt
CASE 1, 4, 6, 9, 11: Rtog shrp_flt
END SELECT
CASE 6:
SELECT CASE k% ' Locrian
CASE 0, 2, 4, 5, 7, 9, 10: Stog shrp_flt
CASE 1, 3, 6, 8, 11: Rtog shrp_flt
END SELECT
END SELECT
END SUB 'Signature
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ HIGHLIGHT SCALE/NOTE FRET POSITIONS
FUNCTION SpotFret% (st AS INTEGER, fr AS INTEGER)
DIM sr%, y%, a%, x%, r%, ps%, c~&, rr%, f
sr% = _HEIGHT(fb&) / 6 ' string range
y% = neckdown% + st * sr% + (sr% / 2) ' string position
IF fr = 0 THEN
a% = capo%
x% = nut% - .5 * sr% ' open string position
r% = .4 * sr%
ELSEIF fr > capo% THEN
a% = 0
x% = nut% + fr * Fret_Wide% - ((bridge% - nut%) / 48) ' fret position
r% = .5 * sr%
END IF
ps% = frets(st, fr) + a%
IF note(ps%).sd <> 0 THEN ' note chosen either scale or individually
SpotFret% = TRUE
c~& = note(ps%).c
IF note(ps%).sd = 1 THEN ' note is a scale tonic
DIM AS _UNSIGNED LONG rred, grn, blu, alf
rred = _RED32(c~&): grn = _GREEN32(c~&): blu = _BLUE32(c~&)
alf = _ALPHA32(c~&)
FOR rr% = r% TO 0 STEP -1 ' draw hemi gradient for tonic note
f = 1 - SIN((rr% * .5) / r%)
IF f > 1 THEN f = 1
FCirc x%, y%, rr%, _RGBA32(rred * f, grn * f, blu * f, alf)
CIRCLE (x%, y%), r%, Black
NEXT
ELSE ' note single or scale degree 2-7
FCirc x%, y%, r%, c~&
CIRCLE (x%, y%), r%, Black ' add contrast border
IF note(ps%).sd <> -1 THEN ' note a non-root scale degree
Divisions x%, y%, r%, note(ps%).sd, note(ps%).c
END IF
END IF
ELSE
SpotFret% = FALSE
END IF
END FUNCTION 'SpotFret%
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ DEFINE CLEAN STAFF IMAGE
SUB Staff
DIM y%, sp%, gc$, fc$, x%
_DEST st&
CLS , PapayaWhip 'White
y% = _HEIGHT(st&) * .45
sp% = _HEIGHT(st&) * .05
gc$ = "FEDCBAGFE"
fc$ = "AGFEDCBAG"
COLOR Green
_PRINTMODE _KEEPBACKGROUND
FOR x% = 0 TO 4
IF x% < 4 THEN
LINE (_WIDTH * .01, y% + (sp% * x%))-(_WIDTH(st&) * .02, y% + sp% + (sp% * x%)), Black, BF
LINE (_WIDTH * .01, y% + (sp% * (x% + 6)))-(_WIDTH(st&) * .02, y% + sp% + (sp% * (x% + 6))), Black, BF
_PRINTSTRING (_WIDTH - 25, y% + (sp% * x%)), _TRIM$(MID$(gc$, (x% * 2) + 2, 1))
_PRINTSTRING (_WIDTH - 25, y% + (sp% * (x% + 6))), _TRIM$(MID$(fc$, (x% * 2) + 2, 1))
END IF
LINE (_WIDTH * .01, y% + (sp% * x%))-(_WIDTH(st&), y% + (sp% * x%)), Black, BF
LINE (_WIDTH * .01, y% + (sp% * (x% + 6)))-(_WIDTH(st&), y% + (sp% * (x% + 6))), Black, BF
_PRINTSTRING (_WIDTH - 15, y% + (sp% * x%) - 8), _TRIM$(MID$(gc$, (x% * 2) + 1, 1))
_PRINTSTRING (_WIDTH - 15, y% + (sp% * (x% + 6)) - 8), _TRIM$(MID$(fc$, (x% * 2) + 1, 1))
NEXT x%
COLOR White
FOR x% = -1 TO -8 STEP -1 ' short ledgers
LINE (_WIDTH / 2 - 20, y% + (sp% * x%))-(_WIDTH(st&) - 1, y% + (sp% * x%)), Gray, , &HFF00 ' gray dotted upper registers
NEXT x%
Image_Resize 0, _HEIGHT(st&) * .325, _WIDTH(st&) - 1, _HEIGHT(st&) * 1.075, clefp&, st&, "l", "c"
_FREEIMAGE clefp&
_DEST 0
END SUB 'Staff
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ NOTATE GRANDSTAFF
SUB Stafftmp (a%, t AS tone)
DIM radius%, sp$, ad%, nf%, k%, c&, fs$, ac$, s&, x%, acc%, wd%, ht%, foff%
DIM b%, sig$, sig%, np%, lp%, x1%, x2%, y1%, y2%
radius% = _HEIGHT(st&) * 0.025
IF a% THEN ' noted staff
_DEST sttmp&
_PUTIMAGE , st& ' grand staff underlay
sp$ = LEFT$(t.ft, 2)
IF sp$ = "Cb" THEN ad% = 0 ELSE ad% = 1 ' trap Cb1 wrong staff position
IF sp$ = "B#" THEN ad% = 2 ' trap B# octave lift
nf% = INSTR("CDEFGAB", LEFT$(sp$, 1)) - 1
k% = _HEIGHT(st&) * (.875 - (t.oc - ad%) * .176 - nf% * 0.025) + 1
IF MID$(sp$, 2, 1) <> "" THEN
c& = _DEFAULTCOLOR
COLOR Black
_PRINTMODE _KEEPBACKGROUND
_PRINTSTRING (_WIDTH / 2 - 16, k% - 16), MID$(sp$, 2, 1)
COLOR c&
END IF
FCirc _WIDTH / 2, k%, radius%, Black ' display chosen tone
IF t.indx = 12 AND sp$ <> "B#" THEN ' if middle C then draw line
LINE (_WIDTH / 2 - radius% * 1.5, k% - 1)-(_WIDTH / 2 + radius% * 1.5, k% + 1), Black, BF
END IF
ELSE ' clean staff
_DEST sttmp&
_PUTIMAGE , st& ' overlay clean staff image
END IF
IF Vtog(scale_on) THEN ' SCALE MODE- display key signature
COLOR Black
IF Vtog(shrp_flt) THEN ' add flats
fs$ = "Bb2Eb3Ab2Db3Gb2Cb3Fb2": ac$ = "b": s& = flat&
ELSE ' add sharps
fs$ = "F#3C#3G#3D#3A#2E#3B#2": ac$ = "#": s& = sharp&
END IF
DO
IF note(x% + 12).sd > 0 AND MID$(note(x% + 12).ft, 2, 1) = ac$ THEN acc% = acc% + 1
x% = x% + 1
LOOP UNTIL x% = 12
wd% = _HEIGHT(st&) * .05 ' let width equal line spacing
ht% = _SHL(wd%, 1) ' double that for height
foff% = _HEIGHT(st&) * .350 ' F clef offset
_PRINTMODE _KEEPBACKGROUND
FOR b% = 1 TO acc%
sig$ = MID$(fs$, 3 * (b% - 1) + 1, 3)
sig% = VAL(MID$(sig$, 3, 1))
np% = INSTR("CDEFGAB", LEFT$(sig$, 1)) - 1
lp% = _HEIGHT(st&) * (.875 - ((sig% - 1) * .176) - (np% * 0.025))
x1% = b% * (wd% * .75) + _WIDTH(st&) * .15
x2% = x1% + wd%
y1% = lp% - (ht% * .75)
y2% = lp% + (ht% * .25)
Image_Resize x1%, y1%, x2%, y2%, s&, sttmp&, "c", "c" 'place G clef signature
Image_Resize x1%, y1% + foff%, x2%, y2% + foff%, s&, sttmp&, "c", "c" 'place F clef signature
NEXT b%
COLOR White
END IF
_DEST 0
END SUB 'Stafftmp
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ APPLY FRETBOARD NOTE NAMES
SUB Fret_Name
DIM flat%, ntf%, onscl%, n%, look%, adj%, scale%, n$, t$
flat% = Vtog(shrp_flt): ntf% = NOT flat%
onscl% = Vtog(scale_on)
FOR n% = 0 TO 56 ' iterate the main note array
scale% = note(n%).sd > 0
n$ = NoteName(note(n%)) ' set a standard mode name until otherwise indicated
IF onscl% AND scale% THEN ' if scale mode on & note in scale
look% = (11 * (n% = 0) + (n% - 1) * (n% > 0)) * flat% + ((n% + 1) * (n% < 56) + (n% - 11) * (n% = 56)) * ntf%
adj% = note(look%).sd > 0
IF adj% AND LEFT$(n$, 1) = LEFT$(NoteName(note(look%)), 1) THEN 'check for duplicate note name if adjacent
IF flat% THEN t$ = note(n%).bf ELSE t$ = note(n%).bs 'set alternate note name
IF t$ <> "" THEN n$ = t$
END IF ' end: adjacent in scale & duplicate name test
END IF ' end: scale mode & note in scale test
note(n%).ft = n$ ' set fret display note name in array element
NEXT n%
END SUB 'Fret_Name
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ APPLY NOTES TO FRETBOARD
SUB String_Notes
DIM dfc&, fr_rng%, st_rng%, st_ps%, st%, fr%, az%, xp%, ps%, nf$, j%
dfc& = _DEFAULTCOLOR
COLOR Aqua
fr_rng% = Fret_Wide%
st_rng% = (_HEIGHT(fb&) - 1) / 6
Fret_Name
FOR st% = 0 TO 5 ' iterate through strings
st_ps% = st_rng% * st% + (_SHR(st_rng%, 1))
FOR fr% = 0 TO fretmax% ' iterate through frets of string st%
IF fr% = 0 THEN
az% = capo%: xp% = nut% - (_SHR(fr_rng%, 1)) - 8
ELSE
az% = 0: xp% = nut% + (fr% * fr_rng%) - (_SHR(fr_rng%, 1)) - 4
END IF
ps% = frets(st%, fr% + az%)
nf$ = _TRIM$(note(ps%).ft) + _TRIM$(STR$(note(ps%).oc)) 'add octave ID
IF Vtog%(picked) THEN j% = SpotFret%(st%, fr%) '
IF Vtog%(all_nat) AND note(ps%).ac THEN _CONTINUE
IF fr% = 0 OR fr% > capo% THEN ' print all not behind capo
IF Vtog%(hide_show) THEN _PRINTSTRING (xp% + (8 * Vtog%(scale_on)), st_ps% + neckdown% - 4), nf$
END IF
NEXT fr% ' next fret
NEXT st% ' next string
COLOR dfc&
END SUB 'String_Notes
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ DISPLAY SCALE INFO
SUB Circle_of_Fifth
DIM in%, rds%, rdf%, rdc%, rhf%, i%, tc!, ts!, pc, tx%, ty%, pi6!
DIM ps!, hi%, n$, ox%, oy%, ks$, dcl&, pin%(3), m%
DIM AS V2 cen
in% = 9 ' starting at 3 o'clock
dcl& = _DEFAULTCOLOR
CentRg cen, bt(20).r
rds% = cen.x * outring ' outer note ring
rdf% = cen.x * inring ' inner note ring
rdc% = cen.x * .3 ' clear all ring
rhf% = (rds% - rdf%) / 2 ' half ring offset
LINE (bt(20).r.ul.x, bt(20).r.ul.y)-(bt(20).r.lr.x, bt(20).r.lr.y), &H7F7F7F7F, B
CIRCLE (cen.x, cen.y), rdc%, Red
CIRCLE (cen.x, cen.y), rds%, Red: CIRCLE (cen.x, cen.y), rds% + 2, Blue
CIRCLE (cen.x, cen.y), rdf%, Red
pin%(0) = WhatMode% * 2 + (WhatMode% > 2)
pin%(1) = Pfifth%(pin%(0), 1)
pin%(2) = Pfifth%(pin%(1), 5)
pin%(3) = Pfifth%(pin%(2), 5)
FOR i% = 0 TO 11
pi6! = .523598 * i%
tc! = COS(pi6!): ts! = SIN(pi6!) ' text point angle _PI / 6 = .523598
pc! = COS(pi6! - .261799): ps! = SIN(pi6! - .261799) ' dividing line angle _PI / 12 = .261799
tx% = cen.x + (rhf% + rdf%) * tc! ' text center x
ty% = cen.y + (rhf% + rdf%) * ts! ' text center y
hi% = in% + 12
n$ = NoteName$(note(hi%))
IF Vtog%(scale_on) THEN ' if scale chosen
m% = 0
DO
IF pin%(m%) = in% THEN
COLOR Lime
EXIT DO
END IF
m% = m% + 1
LOOP UNTIL m% = 4
IF NoteName$(tonic) = n$ THEN ' if note is tonic
FCirc tx%, ty%, 15, Gray ' mark it
END IF
ox% = cen.x + (rdf% - rhf%) * tc! ' object center x
oy% = cen.y + (rdf% - rhf%) * ts! ' object center y
IF Vtog%(shrp_flt) THEN ks$ = "b" ELSE ks$ = "#"
IF note(hi%).sd > 0 THEN
IF note(hi%).nt = "*" OR note(hi%).ft = "Cb" OR note(hi%).ft = "E#" OR note(hi%).ft = "B#" OR note(hi%).ft = "Fb" THEN
IF note(hi%).ft = "Cb" THEN n$ = "Cb"
IF note(hi%).ft = "E#" THEN n$ = "E#"
IF note(hi%).ft = "B#" THEN n$ = "B#"
IF note(hi%).ft = "Fb" THEN n$ = "Fb"
FCirc ox%, oy%, 10, Red
ELSE
FCirc ox%, oy%, 10, Blue
END IF
Divisions ox%, oy%, 10, note(hi%).sd, Black
END IF
END IF
_PRINTSTRING (tx% - (4 * LEN(n$)), ty% - 8), n$ ' print note in note ring position
COLOR dcl&
LINE (cen.x + rdf% * pc!, cen.y + rdf% * ps!)-(cen.x + rds% * pc!, cen.y + rds% * ps!), Red
in% = Pfifth%(in%, -5)
NEXT i%
_PRINTSTRING (cen.x - 36, cen.y - 8), "Clear All"
IF Vtog%(mode_lock) THEN
COLOR Red
_PRINTSTRING (cen.x - 36, cen.y - (cen.x * .4)), "Mode Lock"
COLOR dcl&
END IF
END SUB 'Circle_of_Fifth
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ VECTOR ADDITION
SUB R2_Add (re AS V2, se AS V2, m AS INTEGER)
re.x = re.x + se.x * m
re.y = re.y + se.y * m
END SUB 'R2_Add
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ COMMENTS AND NOTES
SUB Theory
' I II III IV V VI VII I
'tonic, supertonic, mediant, subdominant, dominant, submediant, leading and tonic.
'KEY #SHARP/FLAT SHARP/FLAT LIST I ii iii IV V vi vii RELATIVE MINOR
'C# major 7 sharps F#-C#-G#-D#-A#-E#(F)-B#(C) C#- D#- E#(F)- F#- G#- A#- B#(C)
'F# major 6 F#-C#-G#-D#-A#-E#(F) F#- G#- A#- B- C#- D#- E#(F)
'B major 5 F#-C#-G#-D#-A# B- C#- D#- E- F#- G#- A# Ab minor
'E major 4 F#-C#-G#-D# E- F#- G#- A- B- C#- D# Db minor
'A major 3 F#-C#-G# A- B- C#- D- E- F#- G# Gb minor
'D major 2 F#-C# D- E- F#- G- A- B- C# B minor
'G major 1 F# G- A- B- C- D- E- F# E minor
'C major - C- D- E- F- G- A- B A minor
'F major 1 flat Bb F- G- A- Bb- C- D- E D minor
'Bb major 2 Bb-Eb Bb- C- D- Eb- F- G- A G minor
'Eb major 3 Bb-Eb-Ab Eb- F- G- Ab- Bb- C- D C minor
'Ab major 4 Bb-Eb-Ab-Db Ab- Bb- C- Db- Eb- F- G F minor
'Db major 5 Bb-Eb-Ab-Db-Gb Db- Eb- F- Gb- Ab- Bb- C Bb minor
'Gb major 6 Bb-Eb-Ab-Db-Gb-Cb(B) Gb Ab Bb Cb(B)- Db Eb F Eb minor
'Cb major 7 Bb-Eb-Ab-Db-Gb-Cb(B)-Fb(E) Cb(B)- Db- Eb- Fb(E)- Gb- Ab- Bb Ab minor
'INTERVALS
'0 perfect unison
'1 minor 2nd...............semitone
'2 major 2nd...............tone
'3 minor 3rd
'4 major 3rd
'5 perfect 4th
'6 aug 4th/dim 5th.........tritone
'7 perfect 5th
'8 minor 6th
'9 major 6th
'10 minor 7th
'11 major 7th
'12 octave
'MNEMONICS
'Father Charles Goes Down And Ends Battle
'Battle Ends And Down Goes Charles Father
END SUB 'Theory
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ CLEAR CHORD COLOR
SUB UnChord
DIM x%
FOR x% = 0 TO 56
IF note(x%).sd > 0 THEN
note(x%).c = sclcol
END IF
NEXT x%
END SUB 'UnChord
'ÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛÛ
FUNCTION WhatMode%
DIM x%
FOR x% = 0 TO 6
IF Vtog%(x%) THEN EXIT FOR
NEXT x%
WhatMode% = x%
END FUNCTION 'WhatMode%RE: Learning guitar - madscijr - 03-18-2025
Thanks for the update... What I need is a visual cue and an auditory cue to understand what a circle of fifths even is, LoL!
I don't use a capo, do chord voicings really change with a capo? I would think the chord shapes would stay the same, everything just moves up the neck?
Your program is definitely introducing me to aspects of the guitar I haven't had to think about!
RE: Learning guitar - OldMoses - 03-18-2025
(03-18-2025, 04:50 PM)madscijr Wrote: Thanks for the update... What I need is a visual cue and an auditory cue to understand what a circle of fifths even is, LoL!
I don't use a capo, do chord voicings really change with a capo? I would think the chord shapes would stay the same, everything just moves up the neck?
Your program is definitely introducing me to aspects of the guitar I haven't had to think about!
A capo alters the base chord up the number of semitones equal to the fret position. For instance, if you play a C major chord form on open strings, you'll get the C major chord sound. If you place a capo on fret two and play the same chord form the actual chord sound will be a D major. One of the main reasons for using a capo is to play certain keys that have unusual chords, while still using the basic cowboy chord forms. That explanation might be clear as mud... suffice to say that a capo will alter the open chord voicings of what you are playing, which gives the ability to change the character of the music significantly.
The circle of fifths is a way of relating the various keys to each other. It's the best available way to understand the strange patterns of western diatonic music. Each advance clockwise on the circle gives the root of the key a perfect fifth (7 semitones) above the previous one.
RE: Learning guitar - madscijr - 03-18-2025
Thanks... I would need to break out the capo and play with it, because all I recall it doing is make the pitch higher the higher up you place it. Putting the capo on the first fret is equal go tuning all 6 strings up a whole step. I don't really care what note it is, it's all relative. It isn't that simple?
Thanks for explaining the circle of fifths, but I don't think I know enough to even understand that! I didn't even know what a perfect fifth was until you said it was 7 semitones, LoL. I do appreciate you trying to explain this stuff - I've been playing and writing original music for >40 years and haven't ever used any theory, and thinking of music in terms of these strange rules is really quite alien to me. It's like being a cook who knows how to use spices and how to cook, suddenly seeing the ingredients described in terms of the chemical elements they're composed of. It's frustrating, but also interesting.
Anyway, keep up the good work!