Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Learning guitar
#1
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.  Wink

The attachment has the image files that are embedded. This was my first time trying the EMBED feature.


.7z   FB4_2.7z (Size: 24.8 KB / Downloads: 37)

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 'UnChord
DO: LOOP: DO: LOOP
sha_na_na_na_na_na_na_na_na_na:
Reply
#2
+1 love idea of mixing your hobbies here!

I remember a while back Luke was doing an interpreter (or something with programming) with music!
b = b + ...
Reply
#3
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]

This is super advanced and awesome. I get no sound how do I make it play sounds? Smile

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 Smile

Thank you for sharing @OldMoses
grymmjack (gj!)
GitHubYouTube | Soundcloud | 16colo.rs
Reply
#4
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?
Reply
#5
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.
DO: LOOP: DO: LOOP
sha_na_na_na_na_na_na_na_na_na:
Reply
#6
(03-15-2025, 01:58 PM)OldMoses Wrote: 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.
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.

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
I think that would be a worthy improvement. 

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.
Reply
#7
(03-17-2025, 07:18 PM)madscijr Wrote:
(03-15-2025, 01:58 PM)OldMoses Wrote: 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.
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.
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.

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. Wink

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%
DO: LOOP: DO: LOOP
sha_na_na_na_na_na_na_na_na_na:
Reply
#8
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!
Reply
#9
(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.
DO: LOOP: DO: LOOP
sha_na_na_na_na_na_na_na_na_na:
Reply
#10
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!
Reply




Users browsing this thread: 2 Guest(s)