Liberty BASIC Community Forum
« Piano7.bas »

Welcome Guest. Please Login or Register.
Jan 22nd, 2018, 6:07pm


Rules|Home|Help|Search|Recent Posts|Notification

Problems installing Liberty BASIC? Read the Vista/Win7 Installation FAQ
Looking for a categorized List of Bug Reports? Visit the Liberty BASIC Bug Tracker

« Previous Topic | Next Topic »
Pages: 1  Notify Send Topic Print
 thread  Author  Topic: Piano7.bas  (Read 136 times)
Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

Gender: Male
Posts: 5618
xx Piano7.bas
« Thread started on: Dec 15th, 2017, 07:06am »

Piano6.bas was not working with touchscreen input. Essentially a touch or tap immediately delivers a leftButtonDown /leftButtonUp pair. This immediately silenced the note. Press and hold starts a gesture and will deliver a rightButtonDown / rightButtonUp pair but only on release. This prevents touch working exactly like the mouse.

This code sets a standard one second cutoff for all notes though you can change the note at any time. You can touch tap keys on screen and drag across the keyboard. The mouse works normally as do the keys.

Fixed some other data typing ulong for handles and the struct pointer to ulong.

Code:
    'piano7.bas
    'A cool piano that uses Windows' built-in MIDI synthesizer
    'plays one note at a time on channel 1 (channel 1 = 144)
    'allows selection from 128 MIDI voices

    'This version has been altered to interact with touchscreen
    'input


    NoMainWin

    Dim ins$(128)   'names of instruments

    'read instrument name data into array for use in the combobox
    For vc = 0 to 127
        Read data$
        ins$(vc)=data$
    Next vc

    'combobox index is 1-based, instrument voices are 0-based
    instrum=1 'select first instrument voice
    voice=0   'voice 0 = instrum 1



    'set up our window
    msg$="To play the piano, touch the screen or click with your mouse " _
    +"or type on keyboard. Select a voice from the combobox."

    WindowWidth=640
    WindowHeight=240
    UpperLeftX=10
    UpperLeftY=10
    Button #p.default, "Close",[quit],UL,520,15,96,30
    Statictext #p, "Select Instrument",15,5,200,20
    Combobox #p.ins, ins$(,[changeInstrument],15, 25, 220,400
    Graphicbox #p.g, 0, 70,638,100
    Statictext #p.vol, msg$,15,180,600,40
    Open "Electronic Piano" For Window_nf As #p

    LoadBmp "piano","piano6.bmp"
    #p.g   "down;drawbmp piano 0 0;flush"

    'now set up events, look for mouse down or key click
    #p.g   "setfocus; when leftButtonDown [mouseNote]"
    #p.g   "when characterInput [keyNote]"
    #p.g   "when leftButtonMove [moveNote]"
    #p.ins "select Grand Piano"
    #p     "trapclose [quit]"

    Wnd=hWnd(#p.g)  'handle of graphicbox
    'get device context for graphicbox
    CallDLL #user32, "GetDC",_
        Wnd As ulong,  hDC As ulong

    'open midi device and obtain handle
    'midi functions return 0 if successful
    struct m, h As ulong
    CallDLL #winmm, "midiOutOpen",_
        m As struct,-1 As long,0 As long,_
        0 As long,0 As long,ret As long

    hMidiOut=m.h.struct    'handle to midi device
    Wait




[changeInstrument]
    'user selected an instrument voice
    #p.ins "selectionindex? instrum"
    #p.g   "setfocus"
    'signal a voice change
    event=192  'event 192 = change
    voice=instrum-1
    velocity=127
    low=(voice*256)+event
    hi=velocity*256*256
    dwMsg=low+hi
    CallDLL #winmm, "midiOutShortMsg",hMidiOut As ulong,_
        dwMsg As ulong, ret As ulong
    Wait

[moveNote]
    'mouse moved while button was down
    move=1

[mouseNote]
    'mouse clicked or moved to start new note
    MX=MouseX:MY=MouseY

    CallDLL #gdi32, "GetPixel",hDC As ulong,_
        MX As long,MY As long,keyColor As long

    If keyColor=0 Then  'black keys
        If MX>32  and MX<=54  Then note = 49   'c#
        If MX>75  and MX<=98  Then note = 51   'd#
        If MX>161 and MX<=185 Then note = 54   'f#
        If MX>205 and MX<=229 Then note = 56   'g#
        If MX>244 and MX<=268 Then note = 58   'a#
        If MX>332 and MX<=356 Then note = 61   'c#
        If MX>375 and MX<=399 Then note = 63   'd#
        If MX>461 and MX<=485 Then note = 66   'f#
        If MX>505 and MX<=529 Then note = 68   'g#
        If MX>544 and MX<=568 Then note = 70   'a#
    Else  'white keys
        If MX>2 and MX<=43  Then note = 48   'c
        If MX>46 and MX<=86  Then note = 50   'd
        If MX>89 and MX<=129 Then note = 52   'e
        If MX>132 and MX<=172 Then note = 53   'f
        If MX>175 and MX<=215 Then note = 55   'g
        If MX>218 and MX<=258 Then note = 57   'a
        If MX>261 and MX<=300 Then note = 59   'b
        If MX>303 and MX<=343 Then note = 60   'c
        If MX>346 and MX<=386 Then note = 62   'd
        If MX>389 and MX<=429 Then note = 64   'e
        If MX>431 and MX<=472 Then note = 65   'f
        If MX>475 and MX<=515 Then note = 67   'g
        If MX>518 and MX<=558 Then note = 69   'a
        If MX>561 and MX<=600 Then note = 71   'b
        If MX>603 and MX<=638 Then note = 72   'c
    End If
    'if the mouse is moving but the note is the same
    'do nothing
    if move and note=lastnote then
        'null
        move=0
        note=lastnote
    else
        gosub [playNewNote]
        'decide how we are going to stop it
        timer 1000, [cutOff]
        '#p.g   "when leftButtonUp [cutOff]"
    end if
    Wait


[keyNote]
    'a keyboard key was pressed
    k = asc(Inkey$)
    select case
        case  (k>96) and (k<123)
            note=k-50   'lowercase letters
        case (k>64) and (k<91)
            note=k-18   'uppercase letters
        case else
            note=48     'non-alpha key
    end select
    gosub [playNewNote]
    'decide to stop it in one second
    timer 1000, [cutOff]
    wait



[cutOff]
    'stop last note from playing
    timer 0
    event=144    'event 144 = play on channel 1
    low=(lastnote*256)+event
    hiZero=0     'stop note from sounding by setting velocity to 0
    dwMsg=low+hiZero
    CallDLL #winmm, "midiOutShortMsg",hMidiOut As ulong,_
        dwMsg As ulong, ret As ulong
    lastnote=0
    wait


[quit]
    'stop note from playing
    timer 0
    event=128    'event 128 = stop play
    low=(note*256)+event
    dwMsg=low+hi
    CallDLL #winmm, "midiOutShortMsg",hMidiOut As ulong,_
        dwMsg As ulong, ret As ulong
    'close midi player
    CallDLL #winmm, "midiOutClose", hMidiOut As ulong,_
        ret As ulong
    'release graphic DC
    CallDLL#user32,"ReleaseDC",_
        Wnd As ulong,hDC As ulong,result As long
    Close #p
    UnloadBmp "piano"
    End

[playNewNote]
    'stop last note from playing
    timer 0
    event=144    'event 144 = play on channel 1
    low=(lastnote*256)+event
    hiZero=0     'stop note from sounding by setting velocity to 0
    dwMsg=low+hiZero
    CallDLL #winmm, "midiOutShortMsg",hMidiOut As ulong,_
        dwMsg As ulong, ret As ulong
    'play new note
    lastnote=note
    event=144   'event 144 = play on channel 1
    low=(note*256)+event
    velocity=127
    hi=velocity*256*256
    dwMsg=low+hi
    CallDLL #winmm, "midiOutShortMsg",hMidiOut As ulong,_
        dwMsg As ulong, ret As ulong
    return




'list of 128 voices, in order of their MIDI indexes
Data "Grand Piano","Bright Grand","Electric Grand","Honky Tonk"
Data "Rhodes","Chorus Piano","Harpsichord","Clavinet"
Data "Celesta","Glockenspiel","Music Box","Vibraphone"
Data "Marimba","Xylophone","Tubular Bells","Dulcimer"
Data "Hammond Organ","Percussion Organ","Rock Organ"
Data "Church Organ","Reed Organ","Accordian","Harmonica"
Data "Tango Accordian","Accoustic Nylon Guitar"
Data "Accoustic Steel Guitar","Electric Jazz Guitar"
Data "Electric Clean Guitar","Electric Mute Guitar"
Data "Overdrive Guitar","Distorted Guitar","Guitar Harmonic"
Data "Accoustic Bass","Electric Bass Finger","Electric Bass Pick"
Data "Fretless Bass","Slap Bass One","Slap Bass Two"
Data "Synth Bass One","Synth Bass Two","Violin","Viola","Cello"
Data "Contrabass","Tremolo Strings","Pizzicato Strings"
Data "Orchestra Harp","Timpani","String Ensemble One"
Data "String Ensemble Two","Synth Strings One","Synth Strings Two"
Data "Choir Ahhs","Voice Oohs","Synth Voice","Orchestra Hit"
Data "Trumpet","Trombone","Tuba","Mute Trumpet","French Horn"
Data "Brass Section","Synth Brass One","Synth Brass Two"
Data "Soprano Sax","Alto Sax","Tenor Sax","Bari Sax","Oboe"
Data "English Horn","Bassoon","Clarinet","Piccolo","Flute"
Data "Recorder","Pan Flute","Bottle Blow","Shakuhachi","Whistle"
Data "Ocarina","Square Wave","Sawtooth","Caliope","Chiff Lead"
Data "Charang","Solo Synth VX","Brite Saw","Brass and Lead"
Data "Fantasia Pad","Warm Pad","Poly Synth Pad","Space Vox Pad"
Data "Bowd Glas Pad","Metal Pad","Halo Pad","Sweep Pad"
Data "Ice Rain","Sound Track","Crystal","Atmosphere","Brightness"
Data "Goblin","Echo Drops","Star Theme","Sitar","Banjo","Shamisen"
Data "Koto","Kalimba","Bagpipe","Fiddle","Shanai"
Data "Tinkle Bell","Agogo","Steel Drums","Wood Block","Taiko Drum"
Data "Melodic Tom","Synth Drum","Rev Cymbal"
Data "Guitar Fret Noise","Breath Noise","Sea Shore","Bird Tweet"
Data "Phone Ring","Helicopter","Applause","Gunshot"



 
User IP Logged

Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

Gender: Male
Posts: 5618
xx Re: Piano7.bas
« Reply #1 on: Dec 22nd, 2017, 08:03am »

Ok, managed to get "touch" working like a mouse. So now the program will play a note while the piano key is pressed and stop when the key is released. It has got beyond anything you would want to ship as an example program but it shows that we can get "touch" to behave more normally.

Someone asked for this, can't quite remember who. While it works it remains mono channel. The next obvious development would be to code for multi touch and play up to six notes at once! Perfectly possible with the touch code Richard provided and the midi message routines tweaked.


http://gamebin.webs.com/Liberty/TouchPiano.zip
User IP Logged

Stefan Pendl
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Computers are like babies, you must teach them what you like them to do ...


Homepage PM

Gender: Male
Posts: 5303
xx Re: Piano7.bas
« Reply #2 on: Dec 23rd, 2017, 01:24am »

It was mentioned on the Yahoo group that touch wouldn't work the way mouse does.
User IP Logged

Stefan

Make sure to read and follow the Forum Guidelines

Liberty BASIC Pro 4.04, Windows 10 Professional x64, Intel Core i7-4710MQ 2.5GHz, 16GB RAM
Pages: 1  Notify Send Topic Print
« Previous Topic | Next Topic »

Rules|Home|Help|Search|Recent Posts|Notification

Liberty BASIC Community Wiki
Wikispaces
Donate $6.99 for 50,000 Ad-Free Pageviews!

| |

This forum powered for FREE by Conforums ©
Sign up for your own Free Message Board today!
Terms of Service | Privacy Policy | Conforums Support | Parental Controls