Dav's Harp - A simple virtual wooden harp to play

[Dav]

I got this harp idea driving home from Thanksgiving dinner last night, and quickly coded it before going to bed.  It's a virtual harp you can play using the keyboard.  The harp sounds are recorded from a real wooden harp that I made a few years ago out of odds and ends around the house, like legs from a busted table, tuning pegs from a broken ukulele.  I will post an image of my homemade harp below, but I used another harp image for the program (it looked better).

Play the 12 harp strings by using the numbers on your keyboard and the - and = keys -- that's numbers 1,2,3,4,5,6,7,8,9,0,-, =.  I may add some other things one day, like nature sounds or birds chirping in the background, maybe recording & playback.  Enjoy hearing my homemade harp.

EDIT: After you grab the complete package below, you can test the new program code with it posted HERE that adds recording/playback of your song.


  davsharp.zip (Size: 274.48 KB / Downloads: 34)

- Dav

Homemade harp the sound samples were recorded from...

   

[Pete]

I got burned buying a harp, once. I couldn't believe the price was so low, so I asked the salesman, "Are there any strings attached?" He said, "No.", so I bought it. To this day I can't get a single sound out of it.

Nice work, + 2

Pete

[Dav]

Ha!  

Hey, thanks for trying it out, Pete!

- Dav

[bplus]

+1 luv these music apps Dav makes!

@dav what are the notes from 1 to 2, that seems an odd jump?

Is there a way to record our masterpieces   ? 
Ah maybe just record the numbers would be enough, I could do that, but to space them out right... ???

[SMcNeill]

I... I.... I FEEL LIKE A MERMAID!! 

[SMcNeill]

(Probably sound like a wet fish too!)

[Pete]

Steve, if you are a mermaid, we'd have a lot more unsunken ships in the harbors!

Pete

[bplus]

LOL now that's a technique I bet Clive Cussler hasn't yet tried in his search for shipwrecks!

Will need a timer for pauses, insert p counts between the notes...  me do this? that Dav might do better than I, it's his app after all, so I can do a card thing, maybe a one hit wonder library item. hmm...

[Dav]

+1 luv these music apps Dav makes!

@dav what are the notes from 1 to 2, that seems an odd jump?

Is there a way to record our masterpieces   ? 
Ah maybe just record the numbers would be enough, I could do that, but to space them out right... ???

It's supposed to be the root, but that string sounded bad, like a thud, so that's why it sounds different.  It's in an A major scale, but I think a different tuning would be better.  I'm going to redo the notes maybe add some more.  I believe the 12 notes from bottom to top are: A B C# D E F# | A B C# D E | A

You have the right idea about adding recording just record the numbers played.  I just made a version to do that for you, here it is below (run it where the harp resource file is).  It records only note keypresses.   When non-note or nothing it pressed, it will save a SPACE to the song data instead.   This will keep the time going in recording and playback.  

Press R to Start/Stop record.  And press P for playback.  

Since the loop runs in_LIMIT 30, it mean 30 characters per second will be recorded and added to song$.  I put a song limit of 10000 characters.  You can change that length in the code.  I can see this music code is getting unorganized just like my music room...  

- Dav

Code: (Select All)

'============

'DavsHarp.bas - v1.1

'============

'A simple virtual harp to play with.

'Coded by Dav for QB64PE, Thanksgiving day, 2025

'Harp sounds are recorded live from a real

'wooden harp that I made (not the one shown).



'New in version 1.1:

'  - Now records/Plays back your song.

'    Press R to start and stop recording.

'    Press P to playback song, if there is one.



'To play all 12 notes on harp, use numbers

'on your keyboard, plus the - and = keys.

'(that's --->>  1,2,3,4,5,6,7,8,9,0,-,=)



'To quit playing, press the ESC key.



'Prees H to see help menu.



'-----------------------------------------------

'NOTE: This program requires the davsharp.dat

'resource file in current directory to run.

'-----------------------------------------------



Screen _NewImage(800, 600, 32)

_FullScreen _SquarePixels



'check if resource file exists.

If Not _FileExists("davsharp.dat") Then

    Print "Can't find davsharp.dat file."

    End

End If



'load davsharp.dat resource file...

Open "davsharp.dat" For Binary As 1

If LOF(1) <> 358053 Then

    Print "Resource file davsharp.dat appears invalid."

    End

End If



'load harp image from resource

b& = CVL(Input$(4, 1)): dat$ = Input$(b&, 1)

back& = _LoadImage(dat$, 32, "memory")

If back& = 0 Then er = 1



'load sound files from resource

b& = CVL(Input$(4, 1)): dat$ = Input$(b&, 1)

note01& = _SndOpen(dat$, "memory"): If note01& = 0 Then er = 1

b& = CVL(Input$(4, 1)): dat$ = Input$(b&, 1)

note02& = _SndOpen(dat$, "memory"): If note02& = 0 Then er = 1

b& = CVL(Input$(4, 1)): dat$ = Input$(b&, 1)

note03& = _SndOpen(dat$, "memory"): If note03& = 0 Then er = 1

b& = CVL(Input$(4, 1)): dat$ = Input$(b&, 1)

note04& = _SndOpen(dat$, "memory"): If note04& = 0 Then er = 1

b& = CVL(Input$(4, 1)): dat$ = Input$(b&, 1)

note05& = _SndOpen(dat$, "memory"): If note05& = 0 Then er = 1

b& = CVL(Input$(4, 1)): dat$ = Input$(b&, 1)

note06& = _SndOpen(dat$, "memory"): If note06& = 0 Then er = 1

b& = CVL(Input$(4, 1)): dat$ = Input$(b&, 1)

note07& = _SndOpen(dat$, "memory"): If note07& = 0 Then er = 1

b& = CVL(Input$(4, 1)): dat$ = Input$(b&, 1)

note08& = _SndOpen(dat$, "memory"): If note08& = 0 Then er = 1

b& = CVL(Input$(4, 1)): dat$ = Input$(b&, 1)

note09& = _SndOpen(dat$, "memory"): If note09& = 0 Then er = 1

b& = CVL(Input$(4, 1)): dat$ = Input$(b&, 1)

note10& = _SndOpen(dat$, "memory"): If note10& = 0 Then er = 1

b& = CVL(Input$(4, 1)): dat$ = Input$(b&, 1)

note11& = _SndOpen(dat$, "memory"): If note11& = 0 Then er = 1

b& = CVL(Input$(4, 1)): dat$ = Input$(b&, 1)

note12& = _SndOpen(dat$, "memory"): If note12& = 0 Then er = 1



If er = 1 Then Print "Error loading resource from davsharp.dat file.": End

Close 1



strings = 12 'number of strings

Dim notex1(strings), notey1(strings)

Dim notex2(strings), notey2(strings)

Dim notevib(strings) 'vibrating value

Dim noteon(strings) 'on/off flag for when note key is pressed



'init all 12 strings x/y positions

notex1(1) = 320: notey1(1) = 58: notex2(1) = 409: notey2(1) = 480

notex1(2) = 336: notey1(2) = 65: notex2(2) = 415: notey2(2) = 480

notex1(3) = 350: notey1(3) = 67: notex2(3) = 420: notey2(3) = 480

notex1(4) = 365: notey1(4) = 72: notex2(4) = 425: notey2(4) = 481

notex1(5) = 380: notey1(5) = 78: notex2(5) = 430: notey2(5) = 481

notex1(6) = 395: notey1(6) = 82: notex2(6) = 435: notey2(6) = 481

notex1(7) = 405: notey1(7) = 84: notex2(7) = 440: notey2(7) = 481

notex1(8) = 415: notey1(8) = 87: notex2(8) = 445: notey2(8) = 481

notex1(9) = 425: notey1(9) = 94: notex2(9) = 449: notey2(9) = 481

notex1(10) = 435: notey1(10) = 97: notex2(10) = 453: notey2(10) = 481

notex1(11) = 445: notey1(11) = 104: notex2(11) = 456: notey2(11) = 481

notex1(12) = 455: notey1(12) = 107: notex2(12) = 458: notey2(12) = 481



'set defaults

record = 0

playback = 0

songcount = 0 'counter for when recording

songlimit = 10000 'about a 5 minute song can be recorded



Do



    _PutImage (0, 0), back&



    PPRINT 625, 570, 16, _RGBA(200, 255, 200, 165), 1, "H=HELP"



    'get keypress, play note

    k$ = UCase$(InKey$)

    If k$ = Chr$(27) Then Exit Do

    If k$ = "1" And noteon(1) = 0 Then notevib(1) = 13: _SndPlayCopy note01&: noteon(1) = 1

    If k$ = "2" And noteon(2) = 0 Then notevib(2) = 13: _SndPlayCopy note02&: noteon(2) = 1

    If k$ = "3" And noteon(3) = 0 Then notevib(3) = 13: _SndPlayCopy note03&: noteon(3) = 1

    If k$ = "4" And noteon(4) = 0 Then notevib(4) = 13: _SndPlayCopy note04&: noteon(4) = 1

    If k$ = "5" And noteon(5) = 0 Then notevib(5) = 13: _SndPlayCopy note05&: noteon(5) = 1

    If k$ = "6" And noteon(6) = 0 Then notevib(6) = 13: _SndPlayCopy note06&: noteon(6) = 1

    If k$ = "7" And noteon(7) = 0 Then notevib(7) = 13: _SndPlayCopy note07&: noteon(7) = 1

    If k$ = "8" And noteon(8) = 0 Then notevib(8) = 13: _SndPlayCopy note08&: noteon(8) = 1

    If k$ = "9" And noteon(9) = 0 Then notevib(9) = 13: _SndPlayCopy note09&: noteon(9) = 1

    If k$ = "0" And noteon(10) = 0 Then notevib(10) = 13: _SndPlayCopy note10&: noteon(10) = 1

    If k$ = "-" And noteon(11) = 0 Then notevib(11) = 13: _SndPlayCopy note11&: noteon(11) = 1

    If k$ = "=" And noteon(12) = 0 Then notevib(12) = 13: _SndPlayCopy note12&: noteon(12) = 1



    'update note on/off flags (trying toprevent fast note buildup playing)

    If k$ <> "1" Then noteon(1) = 0

    If k$ <> "2" Then noteon(2) = 0

    If k$ <> "3" Then noteon(3) = 0

    If k$ <> "4" Then noteon(4) = 0

    If k$ <> "5" Then noteon(5) = 0

    If k$ <> "6" Then noteon(6) = 0

    If k$ <> "7" Then noteon(7) = 0

    If k$ <> "8" Then noteon(8) = 0

    If k$ <> "9" Then noteon(9) = 0

    If k$ <> "0" Then noteon(10) = 0

    If k$ <> "-" Then noteon(11) = 0

    If k$ <> "=" Then noteon(12) = 0



    If k$ = "P" And song$ <> "" Then

        _KeyClear

        If playback = 1 Then

            playback = 0

        Else

            playback = 1

            record = 0

            songpos = 1

        End If

    End If



    'if playing song...

    If playback = 1 Then

        PPRINT 18, 1, 18, _RGBA(100, 255, 100, 225), 1, "Playing..."

        'grab a note from song$

        n$ = Mid$(song$, songpos, 1)

        'if last note, turn playback off

        songpos = songpos + 1

        If songpos > Len(song$) Then playback = 0

        'play note

        If n$ = "1" And noteon(1) = 0 Then notevib(1) = 13: _SndPlayCopy note01&: noteon(1) = 1

        If n$ = "2" And noteon(2) = 0 Then notevib(2) = 13: _SndPlayCopy note02&: noteon(2) = 1

        If n$ = "3" And noteon(3) = 0 Then notevib(3) = 13: _SndPlayCopy note03&: noteon(3) = 1

        If n$ = "4" And noteon(4) = 0 Then notevib(4) = 13: _SndPlayCopy note04&: noteon(4) = 1

        If n$ = "5" And noteon(5) = 0 Then notevib(5) = 13: _SndPlayCopy note05&: noteon(5) = 1

        If n$ = "6" And noteon(6) = 0 Then notevib(6) = 13: _SndPlayCopy note06&: noteon(6) = 1

        If n$ = "7" And noteon(7) = 0 Then notevib(7) = 13: _SndPlayCopy note07&: noteon(7) = 1

        If n$ = "8" And noteon(8) = 0 Then notevib(8) = 13: _SndPlayCopy note08&: noteon(8) = 1

        If n$ = "9" And noteon(9) = 0 Then notevib(9) = 13: _SndPlayCopy note09&: noteon(9) = 1

        If n$ = "0" And noteon(10) = 0 Then notevib(10) = 13: _SndPlayCopy note10&: noteon(10) = 1

        If n$ = "-" And noteon(11) = 0 Then notevib(11) = 13: _SndPlayCopy note11&: noteon(11) = 1

        If n$ = "=" And noteon(12) = 0 Then notevib(12) = 13: _SndPlayCopy note12&: noteon(12) = 1

    End If



    If k$ = "R" Then

        _KeyClear

        If record = 1 Then

            record = 0

        Else

            record = 1: song$ = "" 'recording fresh song

            soundcount = 0

        End If

    End If



    If record = 1 Then

        'only record note keys, ignore all other key presses

        Select Case k$

            Case "1", "2", "3", "4", "5", "6", "7", "8", "9", "0", "-", "="

                song$ = song$ + k$

            Case Else

                song$ = LTrim$(song$) + " "

        End Select

        songcount = songcount + 1

        If songcount > songlimit Then record = 0

        PPRINT 18, 1, 18, _RGBA(255, 100, 100, 225), 1, "Recording..."

    End If



    'update all notes vib value

    For v = 1 To strings

        notevib(v) = notevib(v) - .3

        If notevib(v) < 0 Then notevib(v) = 0

    Next



    'draw all strings

    For d = 1 To strings

        PluckString notex1(d), notey1(d), notex2(d), notey2(d), notevib(d)

    Next



    If k$ = "H" Then

        _Display

        temp& = _CopyImage(_Display)

        Line (175, 100)-(625, 500), _RGBA(0, 0, 0, 165), BF

        Line (175, 100)-(625, 500), _RGBA(200, 255, 200, 175), B

        PPRINT 275, 125, 26, _RGBA(200, 255, 100, 220), 1, "HOW TO PLAY"

        PPRINT 220, 175, 20, _RGBA(200, 255, 200, 175), 1, "There are 12 notes."

        PPRINT 220, 205, 20, _RGBA(200, 255, 200, 175), 1, "Use the numbers and"

        PPRINT 220, 235, 20, _RGBA(200, 255, 200, 175), 1, "'-' and '=' keys to"

        PPRINT 220, 265, 20, _RGBA(200, 255, 200, 175), 1, "play all 12 notes."

        PPRINT 220, 325, 20, _RGBA(200, 255, 200, 175), 1, "R = Records a song."

        PPRINT 220, 355, 20, _RGBA(200, 255, 200, 175), 1, "P = Plays it back."

        PPRINT 220, 385, 20, _RGBA(200, 255, 200, 175), 1, "ESC key will quit."

        PPRINT 220, 435, 20, _RGBA(200, 255, 200, 175), 1, "      ENJOY!"

        _Display

        w$ = Input$(1)

        _PutImage (0, 0), temp&: _Display

        _FreeImage temp&

    End If



    _Display



    _Limit 30

Loop

Cls



Sub PPRINT (x, y, size, clr&, trans&, text$)

    orig& = _Dest

    bit = 32: If _PixelSize(0) = 1 Then bit = 256

    For t = 0 To Len(text$) - 1

        pprintimg& = _NewImage(16, 16, bit)

        _Dest pprintimg&

        Cls , trans&: Color clr&

        Print Mid$(text$, t + 1, 1);

        _ClearColor _RGB(0, 0, 0), pprintimg&

        _Dest orig&

        x1 = x + (t * size): x2 = x1 + size

        y1 = y: y2 = y + size

        _PutImage (x1 - (size / 2), y1)-(x2, y2 + (size / 3)), pprintimg&

        _FreeImage pprintimg&

    Next

End Sub



Sub PluckString (x1, y1, x2, y2, vib)

    'calc middle control points

    cx = ((x1 + x2) / 2) + ((Rnd * vib) - (Rnd * vib))

    cy = ((y1 + y2) / 2) + ((Rnd * vib) - (Rnd * vib))

    oldx = x1

    oldy = y1

    For t = 0 To 1 Step .01

        curx = (1 - t) ^ 2 * x1 + 2 * (1 - t) * t * cx + t ^ 2 * x2

        cury = (1 - t) ^ 2 * y1 + 2 * (1 - t) * t * cy + t ^ 2 * y2

        Line (oldx - 1, oldy - 1)-(curx - 1, cury - 1), _RGBA(200 + (vib * 2), 200 + (vib * 2), 150, 50 + (vib * 7)), BF

        Line (oldx, oldy)-(curx, cury), _RGBA(200 + (vib * 3), 200 + (vib * 3), 150, 75 + (vib * 7)), BF

        Line (oldx + 1, oldy + 1)-(curx + 1, cury + 1), _RGBA(200 + (vib * 2), 200 + (vib * 2), 150, 50 + (vib * 7)), BF

        oldx = curx

        oldy = cury

    Next

End Sub

[bplus]

+1 @dav captures timing perfectly thanks for record and play features, that was quick!