!
!
! ***** SORTING PROCEDURES *****
!
!
PROCEDURE decus$sort (bname,astring)
   decus$shell_sort (bname);
ENDPROCEDURE
!
!
! Sort the named buffer.  Prompt for buffer name if not specified
!
PROCEDURE decus$sort_buffer (buffer_to_sort)
   local v_buf
	,p_buf;
   if not eve$prompt_string 
		(buffer_to_sort, v_buf, "Sort buffer: ", "Cancelled") then 
      RETURN; 
   endif;
   p_buf := decus$find_buffer (v_buf);
   if (p_buf <> 0) then
      decus$shell_sort (p_buf);
   else
      MESSAGE ("Buffer "+v_buf+" not found");
   endif;
ENDPROCEDURE
!
! Compare two strings
!
! Returns:
!	1 if string1 > string2
!	0 if string1 = string2
!	-1 if string1 < string2
!
PROCEDURE decus$string_compare (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 
!           
! This is the shell sort, described in knuth and also
! referred to as the Diminishing Increment Sort.
!
PROCEDURE decus$shell_sort (buffer_to_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);
   decus$x_shellstep_0 := 1;
   decus$x_shellstep_1 := 4;
   decus$x_shellstep_2 := 13;
   decus$x_shellstep_3 := 40;
   decus$x_shellstep_4 := 121;
   decus$x_shellstep_5 := 364;
   decus$x_shellstep_6 := 1093;
   decus$x_shellstep_7 := 3280;
   decus$x_shellstep_8 := 9841;
   decus$x_shellstep_9:= 32767;
   decus$x_gshell := 0;
   decus$x_shell_index := 0;
!
! Find the highest step to use
!
   loop
      decus$x_gshell := 0;
      exitif (decus$x_shell_index >= 6);
      EXECUTE ("if (GET_INFO (CURRENT_BUFFER, 'record_count') <"+
	FAO ("decus$x_shellstep_!UL)",decus$x_shell_index+2)+
	" then decus$x_gshell := 1;endif;");
      if decus$x_gshell then 
	 exitif 1; 
      endif;
      decus$x_shell_index := decus$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 decus$x_shell_index.
!
   loop
      EXECUTE (FAO ("decus$x_gshell := decus$x_shellstep_!UL",
		decus$x_shell_index));
      v_j := decus$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 - decus$x_gshell;		!i = j - h
	 loop
	    POSITION (BEGINNING_OF (CURRENT_BUFFER));
	    MOVE_VERTICAL (v_i - 1);
	    v_iline := CURRENT_LINE;
	    if (decus$string_compare (v_jline, v_iline) >= 0) then
	       POSITION (BEGINNING_OF (CURRENT_BUFFER));
	       MOVE_VERTICAL (v_i + decus$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 + decus$x_gshell - 1);
	       ERASE_LINE;
	       SPLIT_LINE;
	       MOVE_VERTICAL (-1);
	       COPY_TEXT (v_iline);
	       v_i := v_i - decus$x_gshell;
 	       if (v_i < 1) then
		  POSITION (BEGINNING_OF (CURRENT_BUFFER));
		  MOVE_VERTICAL (v_i + decus$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;
      decus$x_shell_index := decus$x_shell_index - 1;
      exitif (decus$x_shell_index <  0);
   endloop;
   POSITION (v_pos);

ENDPROCEDURE;

PROCEDURE tpu$local_init
   decus$arg1_sort_buffer := eve$arg1_buffer;
ENDPROCEDURE;