\ midicapture.f


ONLY FORTH ALSO DEFINITIONS

LIBRARY WINMM.DLL OPENDLLS

3 IMPORT: midiInAddBuffer
1 IMPORT: midiInClose
3 IMPORT: midiInGetDevCaps
3 IMPORT: midiInGetErrorText
2 IMPORT: midiInGetID
0 IMPORT: midiInGetNumDevs
4 IMPORT: midiInMessage
5 IMPORT: midiInOpen
3 IMPORT: midiInPrepareHeader
1 IMPORT: midiInReset
1 IMPORT: midiInStart
1 IMPORT: midiInStop
3 IMPORT: midiInUnprepareHeader

0 IMPORT: midiOutGetNumDevs
3 IMPORT: midiOutGetDevCaps
5 IMPORT: midiOutOpen
2 IMPORT: midiOutShortMsg    
1 IMPORT: midiOutClose

65536 CONSTANT CALLBACK_WINDOW
196608 CONSTANT CALLBACK_FUNCTION

create mih 64 allot
create mic 44 allot
create moc 52 allot
variable hmi 
variable hmo
8 value input-dev
9 value output-dev
0 value transpose 
128 value inversion


: pack-bytes  ( n n n -- n ) 
    65536 * swap 256 * + + ;

: unpack-bytes ( n -- n n n ) 
    dup dup 65536 / dup rot swap
    65536 * - 256 / dup 256 * rot dup 65536 * rot 4 pick swap
    - swap - 3 roll drop rot rot ;

: bang  ( n n n -- n )
    hmo @ swap midiOutShortMsg drop ;

: alloff ( -- )
    127 0 do 128 i 0 pack-bytes hmo @ swap midiOutShortMsg  drop loop ;

: cls  ( -- )
    hmo @ midiOutClose drop ;

\ : midiInCallback ( -- )
\   LPARAM bang ;

\ invert keyboard

 : midiInCallback ( -- )
    LPARAM unpack-bytes swap inversion swap - swap pack-bytes bang ;

\ add interval

\ : midiInCallback ( -- )
\   LPARAM dup unpack-bytes swap transpose + swap pack-bytes bang bang ;

' midiInCallback 5 CB: &CAPTURE-INPUT ;

: init-midiIn ( -- )
    hmi input-dev &CAPTURE-INPUT NULL CALLBACK_FUNCTION midiInOpen drop ;

: init-midiOut ( -- )
    hmo output-dev NULL NULL NULL midiOutOpen drop ;

: init-MIDI ( -- )
    init-midiIn init-midiOut hmi @ midiInStart drop ;

: open-midi ( -- ) 
    init-MIDI ;

: close-midi ( -- )
   hmo @ midiOutClose drop
   hmi @ midiInClose drop ;

CR CR .( Type open-midi and start playing.) CR CR