Posts: 461
Threads: 23
Joined: Nov 2022
Reputation:
51
(03-19-2025, 12:13 PM)OldMoses Wrote: My ap won't play "chords" per se, it will play single tones through the SOUND command, so it's nothing that sophisticated. I envisioned the ap to be a visual aid to the guy with a guitar in his lap for navigating the fret board. Oh, and a tonic (or root) note is the first note in a scale and the note for which the scale is named (i.e. C is the tonic of the C major scale). In my ap, the tonic is indicated by the solid color mark with the SIN gradient. The others are flat colored and pie sliced by their position in the scale progression.
You can play polyphonic voices (up to 4 I think?) in the latest versions of QB64PE:
From wiki: SOUND keyword documentation.
Quote:Optional parameter voice& can be a numeric expression ranging from 0 to 3. It specifies the voice channel that will be used to play the sound.
Multi-voice support was inspired by Amiga Basic and Advanced BASIC (for the IBM PCjr and Tandy 1000).
@OldMoses so you could play a chord with up to 4 notes at once 
@a740g is it possible somehow to play more than 4 notes at once as a guitar has 6 strings? etc.
Posts: 1,041
Threads: 140
Joined: Apr 2022
Reputation:
23
Yes, you can play 4 notes at once with QB64PE's SOUND command, but what about MIDI?
Is polyphony supported? Weren't you wizards working on some new MIDI support?
Posts: 415
Threads: 23
Joined: May 2022
Reputation:
78
04-07-2025, 03:56 AM
(This post was last modified: 04-07-2025, 03:57 AM by a740g.)
You can technically play more than 4 waveforms using PLAY's comma command. In fact, the number of sounds you can play simultaneously this way is unlimited. PLAY and SOUND can play basic waveforms (square, sawtooth, triangle, sine, white noise, pink noise, Brownian noise, LFSR noise and pulse wave). You can play user defined waveforms defined using _WAVE.
If you are looking for MIDI-based player, then take a look at the excellent MidiNotes player / library by @Dav - https://qb64phoenix.com/forum/showthread.php?tid=3016
Posts: 702
Threads: 107
Joined: Apr 2022
Reputation:
27
04-07-2025, 05:59 AM
(This post was last modified: 04-07-2025, 06:00 AM by PhilOfPerth.)
(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. Capo positions can be set with left mouse and upper fretboard masks set with right mouse in the capo track. Center mouse on the fretboard will display notes on staff and keyboard. If sound is chosen it will also sound the tone. I'm sure I've gotten some stuff wrong...ignorance is bliss. 
The attachment has the image files that are embedded. This was my first time trying the EMBED feature.
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
I've never played guitar, but this has caught my interest. Incredibly detailed music theory! I'll be experimenting - not that I expect to learn to play from it, but maybe expand my limited knowledge base.
Just curious: With my OCD, I notice there are five semitones between each string, except the 2nd and third, which only has four. There must be a reason: do you know what it is?
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, Western Australia.) 
Please visit my Website at: http://oldendayskids.blogspot.com/
Posts: 295
Threads: 15
Joined: Apr 2022
Reputation:
37
@PhilOfPerth I don't know for certain why the transition between the second and third string is tuned a major third rather than the perfect fourth of the other strings. I suspect the reason is to make sure the pattern keeps the "cowboy chords" easier to play, but I wouldn't presume that to be the case. I programmed in the tuners to make it easy to investigate various alternate tunings and how they might change chord phrasings. I know that a lot of pro musicians use alternate tunings in various songs. Jimmy Page springs immediately to mind as one who does a lot of alternate tunings in his music.
DO: LOOP: DO: LOOP
sha_na_na_na_na_na_na_na_na_na:
Posts: 702
Threads: 107
Joined: Apr 2022
Reputation:
27
04-07-2025, 10:24 PM
(This post was last modified: 04-07-2025, 10:24 PM by PhilOfPerth.)
(04-07-2025, 01:27 PM)OldMoses Wrote: @PhilOfPerth I don't know for certain why the transition between the second and third string is tuned a major third rather than the perfect fourth of the other strings. I suspect the reason is to make sure the pattern keeps the "cowboy chords" easier to play, but I wouldn't presume that to be the case. I programmed in the tuners to make it easy to investigate various alternate tunings and how they might change chord phrasings. I know that a lot of pro musicians use alternate tunings in various songs. Jimmy Page springs immediately to mind as one who does a lot of alternate tunings in his music.
Thanks for the reply. It's not important, in the big scheme of things, Just struck me as a bit odd, that's all.
I'm enjoying learning a bit more about the intricacies of music, and there are plenty of those here.
Great work!
Of all the places on Earth, and all the planets in the Universe, I'd rather live here (Perth, Western Australia.)
Please visit my Website at: http://oldendayskids.blogspot.com/
Posts: 2,574
Threads: 264
Joined: Apr 2022
Reputation:
140
I used to play guitar as a kid. I was given the choice to either give it up or keep it up and look for someplace else to live. I liked it so much that I tried moving out, but it's harder than hell to find someone to rent to you when you're 10 years old... especially when you can't play the guitar worth a .......
Posts: 1,041
Threads: 140
Joined: Apr 2022
Reputation:
23
It's never too late to start again! Get a cheap electric (Squiers and Epiphones are pretty good) and a headphone amp, that way you won't drive anyone crazy but yourself!
Posts: 2,574
Threads: 264
Joined: Apr 2022
Reputation:
140
04-08-2025, 02:12 AM
(This post was last modified: 04-08-2025, 02:18 AM by Pete.)
Nope. It's just as hard to rent when you're pushing 70, too!
Pete, if you get one more damn hobby!!!!!!!
Actually the wife is great. I got an electric drum set, but then realized' why not get more out of it by converting it to a gas powered version? So I did and it didn't go well. They literally BEAT the _ _ _ _ out of me.
Pete
Posts: 295
Threads: 15
Joined: Apr 2022
Reputation:
37
(04-08-2025, 02:12 AM)Pete Wrote: Actually the wife is great. I got an electric drum set, but then realized' why not get more out of it by converting it to a gas powered version? So I did and it didn't go well. They literally BEAT the _ _ _ _ out of me.
My wife is great too. She hears the same gimped up attempts at songs over and over and yet doesn't beat the hell out of me.
DO: LOOP: DO: LOOP
sha_na_na_na_na_na_na_na_na_na:
|
