$CPU 8086          ' make compatible with XT systems
$LIB ALL OFF       ' turn off all PowerBASIC libraries
$ERROR ALL OFF     ' turn off all PowerBASIC error checking
$OPTIMIZE SPEED    ' optimize for smaller code
$COMPILE UNIT      ' compile to a UNIT (.PBU)
'$COMPILE EXE       ' compile to a UNIT (.PBU)

DEFINT A-Z         ' Required for all numeric functions, forces PB to not
                   ' include floating point in UNIT (makes it smaller)
'/*------------------------------------------------------------------*/
$CODE SEG "MLIB5"
'/*------------------------------------------------------------------*/
' FSORT FILE$, PRECL,SC,NC,OPT$
'     File Sort.
'     Sorts a file containing fixed-length records.  This is an
'     "IN-PLACE" sort where the order of FILE$ records are changed.
'     FILE$  = Name of file to sort.
'     PRECL  = Physical record length.  If sorting a sequential file,
'              (each record has a CRLF at end) then add 2 to the
'              record length.
'     SC     = Start column
'     NC     = Number of columns to look at
'     OPT$   = How to sort:
'              A = Ascending
'              D = Descending or Reverse
'
'     EXAMPLE:  FSORT "C:\CODE\FILESPEC.DAT",43,24,18,"D"
'                              |             |   |  |  |
'                              |             |   |  |  +- Sort high to low
'                              |             |   |  +---- Look at 18 columns
'                              |             |   +------- Start with col 24
'                              |             +----------- Each record is 43 cols long
'                              +------------------------- File to sort
'/*------------------------------------------------------------------*/
 SUB FSORT(Fi$, Reclen,SC%,NC%,TS$) PUBLIC
       TS$ = UCASE$(TS$)
       OPEN Fi$ FOR BINARY AS #1
       CALL QQuickSort(LOF(1)\Reclen, Reclen,SC%,NC%,TS$)
       CLOSE #1
 END SUB


 SUB QQuickSort(Count, Reclen,SC%,NC%,TS$)
  IF TS$ = "A" THEN CALL QUICKSORTA(0, Count-1, Reclen,SC%,NC%)
  IF TS$ = "D" THEN CALL QUICKSORTD(0, Count-1, Reclen,SC%,NC%)
 END SUB

 SUB QUICKSORTA(Port, Starboard, Reclen,SC%,NC%)

         i=Port:j=Starboard

         X$=Item$((Port+Starboard)\2, Reclen)

         DO
                 DO WHILE MID$(Item$(i,Reclen),SC%,NC%)<MID$(X$,SC%,NC%) AND i<Starboard:INCR i:LOOP
                 DO WHILE MID$(Item$(j,Reclen),SC%,NC%)>MID$(X$,SC%,NC%) AND j>Port :DECR j:LOOP

                 IF i<=j THEN
                         CALL SWAPITEMS(i,j,Reclen)
                         INCR i: DECR j:
                         END IF
         LOOP WHILE i<=J

         IF Port < j THEN CALL QUICKSORTA(Port, J, Reclen,SC%,NC%)
         IF i < Starboard THEN CALL QUICKSORTA(i, Starboard, Reclen,SC%,NC%)
 END SUB
 SUB QUICKSORTD(Port, Starboard, Reclen,SC%,NC%)

         i=Port:j=Starboard

         X$=Item$((Port+Starboard)\2, Reclen)

         DO
                 DO WHILE MID$(Item$(i,Reclen),SC%,NC%)>MID$(X$,SC%,NC%) AND i<Starboard:INCR i:LOOP
                 DO WHILE MID$(Item$(j,Reclen),SC%,NC%)<MID$(X$,SC%,NC%) AND j>Port :DECR j:LOOP

                 IF i<=j THEN
                         CALL SWAPITEMS(i,j,Reclen)
                         INCR i: DECR j:
                         END IF
         LOOP WHILE i<=J

         IF Port < j THEN CALL QUICKSORTD(Port, J, Reclen,SC%,NC%)
         IF i < Starboard THEN CALL QUICKSORTD(i, Starboard, Reclen,SC%,NC%)
 END SUB

 FUNCTION Item$(number, Reclen)
         SEEK #1, Number*Reclen
         Get$ 1, Reclen, I$
         Item$=I$
 END FUNCTION

 SUB SWAPITEMS(a,b, Reclen)
 Seek #1, a*Reclen
 Get$ 1, Reclen, A$
 Seek #1, b*Reclen
 Get$ 1, Reclen, B$
 Seek #1, a*Reclen
 PUT$ #1, B$
 Seek #1, b*Reclen
 PUT$ #1, A$
 END SUB
'/*------------------------------------------------------------------*/
'   FSORT "C:\CODE\BBS\JVIEW.DIR", 43, 24, 18, "D"