MODULE TPUPlus_SORT IDENT "910102"
!
! TPUPlus code module
!
! Sort utility procedures
!   PROCEDURE EVE_SORT_BUFFER (BUFFER_TO_SORT)
!   PROCEDURE EVEPLUS$$STRING_COMPARE (STRING1, STRING2)
!   PROCEDURE EVEPLUS$$SHELL_SORT (BUFFER_TO_SORT)
!
!****************************************
PROCEDURE EVE_SORT_BUFFER (BUFFER_TO_SORT)
!
! Sort the named buffer.  Prompt for buffer name if not specified
!
local v_buf, p_buf, this_buffer;

this_buffer := current_buffer;

if not eve$prompt_string (buffer_to_sort, v_buf,
    "Buffer to sort (<RETURN> => current buffer, Ctrl-Z => Quit): ",
    "Cancelled") then
    message("Current buffer will be sorted in ascending order");
    v_buf := get_info(this_buffer, "name");
endif;

if test_if_buffer_exists (v_buf, p_buf) = 1 then
!p_buf := eveplus_find_buffer (v_buf);
!if (p_buf <> 0) then
    eveplus$$shell_sort (p_buf);
else
    message ("Buffer "+v_buf+" not found");
endif;

ENDPROCEDURE;

!****************************************
PROCEDURE EVEPLUS$$STRING_COMPARE (STRING1, STRING2)
!
! Compare two strings
!
! Returns:
!    1 if string1 > string2
!    0 if string1 = string2
!    -1 if string1 < string2
!
local    v_alpha,
    v_c1,
    v_p1,
    v_c2,
    v_i,
    v_p2;

v_alpha := "                " +    !Treat all control chars as spaces???
       "                " +
       " !""#$%&'()*+,-./"+
       "0123456789:;<=>?" +
       "@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_" +
       "`abcdefghijklmnopqrstuvwxyz{|}~";
v_i := 1;
loop
    if (length (string2) < v_i) then
        if (length (string2) = length (string1)) then
            return 0;
        else
            return 1;
        endif;
    endif;
    if (length (string1) < v_i) then
        return -1;
    endif;

    v_c1 := substr (string1, v_i, 1);
    change_case (v_c1, upper);
    v_c2 := substr (string2, v_i, 1);
    change_case (v_c2, upper);
    v_p1 := index (v_alpha, v_c1);
    v_p2 := index (v_alpha, v_c2);

    if (v_p1 < v_p2) then
        return -1;
    endif;

    if (v_p1 > v_p2) then
        return 1;
    endif;

    v_i := v_i + 1;

endloop;

return 1;
ENDPROCEDURE;

!****************************************
PROCEDURE EVEPLUS$$SHELL_SORT (BUFFER_TO_SORT)
!
! This is the shell sort, described in knuth and also
! referred to as the Diminishing Increment Sort.
!
local   v_pos,
        v_iline,
        v_jline,
        v_i,
        v_j,
        v_record;

on_error
    position (v_pos);
    return;
endon_error;

v_pos := mark (none);
position (buffer_to_sort);
eveplus$x_shellstep_0   :=     1;
eveplus$x_shellstep_1   :=     4;
eveplus$x_shellstep_2   :=    13;
eveplus$x_shellstep_3   :=    40;
eveplus$x_shellstep_4   :=   121;
eveplus$x_shellstep_5   :=   364;
eveplus$x_shellstep_6   :=  1093;
eveplus$x_shellstep_7   :=  3280;
eveplus$x_shellstep_8   :=  9841;
eveplus$x_shellstep_9   := 32767;
eveplus$x_gshell        := 0;
eveplus$x_shell_index   := 0;
!
! Find the highest step to use
!
loop
    eveplus$x_gshell := 0;
    exitif (eveplus$x_shell_index >= 6);
    execute ("if (get_info (current_buffer, 'record_count') <"+
        fao ("eveplus$x_shellstep_!UL)",eveplus$x_shell_index+2)+
        " then eveplus$x_gshell := 1;endif;");
    if eveplus$x_gshell then
        exitif 1;
    endif;
    eveplus$x_shell_index := eveplus$x_shell_index + 1;
endloop;

v_record := get_info (current_buffer, 'record_count');
!
! Now we can sort the buffer.  Outer loop loops over all the steps,
! decrementing eveplus$x_shell_index.
!
loop
    execute (fao("eveplus$x_gshell := eveplus$x_shellstep_!UL",
        eveplus$x_shell_index));
    v_j := eveplus$x_gshell + 1;        !Set up loop for step+1-index
    loop
        position (beginning_of (current_buffer));
        move_vertical (v_j - 1);        !Get j'th line
        v_jline := current_line;
        v_i := v_j - eveplus$x_gshell;  !i = j - h
        loop
            position (beginning_of (current_buffer));
            move_vertical (v_i - 1);
            v_iline := current_line;
            if (eveplus$$string_compare (v_jline, v_iline) >= 0) then
                position (beginning_of (current_buffer));
                move_vertical (v_i + eveplus$x_gshell - 1);
                erase_line;
                split_line;
                move_vertical (-1);
                copy_text (v_jline);
                exitif 1;
            else
                position (beginning_of (current_buffer));
                move_vertical (v_i + eveplus$x_gshell - 1);
                erase_line;
                split_line;
                move_vertical (-1);
                copy_text (v_iline);
                v_i := v_i - eveplus$x_gshell;
                if (v_i < 1) then
                    position (beginning_of (current_buffer));
                    move_vertical (v_i + eveplus$x_gshell - 1);
                    erase_line;
                    split_line;
                    move_vertical (-1);
                    copy_text (v_jline);
                    exitif 1;
                endif;
            endif;
        endloop;
        v_j := v_j + 1;
        exitif (v_j > v_record);
    endloop;
    eveplus$x_shell_index := eveplus$x_shell_index - 1;
    exitif (eveplus$x_shell_index <  0);
endloop;

position (v_pos);

ENDPROCEDURE;

ENDMODULE;