variable_length_quantity Function

public pure function variable_length_quantity(i) result(VLQ)

MIDI delta times are composed of one to four bytes, depending on their values. If there is still bytes to write, the MSB (most significant bit) of the current byte is 1, else 0. This functions is automatically tested. https://en.wikipedia.org/wiki/Variable-length_quantity

Arguments

Type IntentOptional Attributes Name
integer(kind=int32), intent(in) :: i

Return Value integer(kind=int8), allocatable, dimension(:)


Called by

proc~~variable_length_quantity~~CalledByGraph proc~variable_length_quantity variable_length_quantity proc~write_variable_length_quantity MIDI_file%write_variable_length_quantity proc~write_variable_length_quantity->proc~variable_length_quantity proc~delta_time MIDI_file%delta_time proc~delta_time->proc~write_variable_length_quantity proc~write_string MIDI_file%write_string proc~write_string->proc~write_variable_length_quantity proc~write_string->proc~delta_time proc~control_change MIDI_file%Control_Change proc~control_change->proc~delta_time proc~copyright_notice MIDI_file%copyright_notice proc~copyright_notice->proc~write_string proc~cue_point MIDI_file%cue_point proc~cue_point->proc~write_string proc~end_of_track MIDI_file%end_of_track proc~end_of_track->proc~delta_time proc~instrument_name MIDI_file%instrument_name proc~instrument_name->proc~write_string proc~lyric MIDI_file%lyric proc~lyric->proc~write_string proc~marker MIDI_file%marker proc~marker->proc~write_string proc~pitch_bend MIDI_file%Pitch_Bend proc~pitch_bend->proc~delta_time proc~play_broken_chord MIDI_file%play_broken_chord proc~play_broken_chord->proc~delta_time proc~play_chord MIDI_file%play_chord proc~play_chord->proc~delta_time proc~play_note MIDI_file%play_note proc~play_note->proc~delta_time proc~program_change MIDI_file%Program_Change proc~program_change->proc~delta_time proc~sequence_track_name MIDI_file%sequence_track_name proc~sequence_track_name->proc~write_string proc~set_tempo MIDI_file%set_tempo proc~set_tempo->proc~delta_time proc~set_time_signature MIDI_file%set_time_signature proc~set_time_signature->proc~delta_time proc~text_event MIDI_file%text_event proc~text_event->proc~write_string program~blues blues program~blues->proc~delta_time program~blues->proc~control_change program~blues->proc~end_of_track program~blues->proc~play_chord program~blues->proc~program_change proc~new MIDI_file%new program~blues->proc~new proc~track_header MIDI_file%track_header program~blues->proc~track_header proc~new->proc~copyright_notice proc~new->proc~end_of_track proc~new->proc~set_tempo proc~new->proc~set_time_signature proc~new->proc~text_event proc~new->proc~track_header proc~track_header->proc~sequence_track_name proc~track_header->proc~text_event program~canon canon program~canon->proc~control_change program~canon->proc~end_of_track program~canon->proc~play_note program~canon->proc~program_change program~canon->proc~new program~canon->proc~track_header program~circle_of_fifths circle_of_fifths program~circle_of_fifths->proc~control_change program~circle_of_fifths->proc~end_of_track program~circle_of_fifths->proc~play_chord program~circle_of_fifths->proc~program_change program~circle_of_fifths->proc~new program~circle_of_fifths->proc~track_header program~la_folia la_folia program~la_folia->proc~control_change program~la_folia->proc~end_of_track program~la_folia->proc~play_broken_chord program~la_folia->proc~play_chord program~la_folia->proc~program_change program~la_folia->proc~new program~la_folia->proc~track_header program~motifs motifs program~motifs->proc~control_change program~motifs->proc~end_of_track program~motifs->proc~play_broken_chord program~motifs->proc~play_chord program~motifs->proc~play_note program~motifs->proc~program_change program~motifs->proc~new program~motifs->proc~track_header program~third_kind third_kind program~third_kind->proc~end_of_track program~third_kind->proc~play_note program~third_kind->proc~program_change program~third_kind->proc~new program~third_kind->proc~track_header

Source Code

    pure function variable_length_quantity(i) result(VLQ)
        integer(int32), intent(in) :: i
        integer(int8), allocatable, dimension(:) :: VLQ
        integer(int32) :: j, again
        ! A First In Last Out 4 bytes stack (or Last In First Out):
        integer(int32) :: filo

        ! We use a variable j because i has intent(in):
        j = i
        filo = 0
        ! The 7 least significant bits are placed in filo (0x7F = 0b01111111):
        filo = iand(j, z'7F')
        ! They are now eliminated from j by shifting bits of j 7 places
        ! to the right (zeros are introduced on the left):
        j = ishft(j, -7)
        ! The same process is a applied until j is empty:
        do
            if (j == 0) exit
            ! The bits already in filo are shifted 1 byte to the left
            ! (filo is Little Endian):
            filo = ishft(filo, +8)
            ! A byte of j with the most signicant bit set to 1 (0x80 = 0b10000000)
            ! can now be added on the right of filo:
            filo = filo + ior(iand(j, z'7F'), z'80')
            ! Preparing next iteration:
            j = ishft(j, -7)
        end do

        ! Starting with a void array:
        allocate(VLQ(0))
        ! The bytes accumulated in filo are now written in the VLQ array
        ! in the reverse order (MIDI files are Big Endian):
        do
            ! Appending the LSB of filo in the VLQ array:
            VLQ = [ VLQ, int(filo, int8) ]
            ! Is the bit 8 a 1? (meaning there is still other bytes to read):
            again = iand(filo, z'80')
            if (again /= 0) then
                ! The written LSB can now be eliminated before next iteration:
                filo = ishft(filo, -8)
            else
                ! Nothing left to write:
                exit
            end if
        end do
    end function variable_length_quantity