LOAD		'Macros.dump'

		INCLUDE	'SS.equ'

		INCLUDE	'Driver.equ'
		INCLUDE	'Heap.aii.i'

;-----------------------------------------------
;
;	Imported addresses
;
;-----------------------------------------------

		IMPORT	D_AlertBox
		IMPORT	D_CmpStrings
		IMPORT	D_MemoryError
		IMPORT	D_NeedHand
		IMPORT	D_Sort

		IMPORT	S_ActiveWindow
		IMPORT	S_BuildSortUndo
		IMPORT	S_CalculateSheet
		IMPORT	S_CurBRMost
		IMPORT	S_CurBRSelect
		IMPORT	S_CurEditFlag
		IMPORT	S_CurRowBlock
		IMPORT	S_CurTLSelect
		IMPORT	S_DeltaMove
		IMPORT	S_DoSortDlog
		IMPORT	S_GetCellIndex
		IMPORT	S_InvalidCellStr
		IMPORT	S_MoveDestBR
		IMPORT	S_MoveDestTL
		IMPORT	S_MoveSrcBR
		IMPORT	S_MoveSrcTL
		IMPORT	S_RedrawCellRange
		IMPORT	S_SetBRMostCell
		IMPORT	S_SetUndoOn
		IMPORT	S_StartSortUndo
		IMPORT	S_SwapCell
		IMPORT	S_SwapIn

;-----------------------------------------------
;
;	Forward addresses and entries
;
;-----------------------------------------------

		ENTRY	S_DoColSort
		ENTRY	S_DoRowSort
		ENTRY	S_SortCompare
		ENTRY	S_SwapColumns
		ENTRY	S_SwapRows

;-------------------------------------------------------------------------
;
;

S_SortData	PROC		EXPORT

		EXPORT	S_SortAscendDescendFlag

S_SortAscendDescendFlag	DS.B 	2

			ENDP

;--------------------------------------------------------------------------
;
;

S_Sort		PROC		EXPORT
			;Using	S_CurrentData
			;Using	S_SortData
			;Using	S_MoveData
			;Using	S_ErrorData

			local	KeyCell:l,Type:w
			error	ErrFlag
			BEGIN	+b

			Call		S_SwapIn,in=(S_ActiveWindow:l)

	;	ascend: 0==decending,1==ascending
	;	rowcol: 0==col by row,1==row by col
	;	cell:   0 == Cancelled, 0 w/carry set == error

			in		S_CurTLSelect:l
			out		S_SortAscendDescendFlag:w,Type:w,KeyCell:l
			XCall	S_DoSortDlog

			bcc		doOK

			Call		D_AlertBox,in=(#OKBox:w,#S_InvalidCellStr:l),out=(a:w)

doOK
			lda		KeyCell
			ora		KeyCell+2
			jeq		Exit

			lda		S_CurEditFlag
			and		#S_BRMostBit
			beq		BRset

			Call		S_SetBRMostCell,in=(#0:w)

BRset
			lda		#S_BRMostBit
			tsb		S_CurEditFlag

			MoveWord	S_CurTLSelect,S_MoveDestTL
			sta		S_MoveSrcTL
			MoveWord	S_CurTLSelect+2,S_MoveDestTL+2
			sta		S_MoveSrcTL+2

			MoveWord	S_CurBRSelect,S_MoveDestBR
			sta		S_MoveSrcBR
			MoveWord	S_CurBRSelect+2,S_MoveDestBR+2
			sta		S_MoveSrcBR+2

			lda		Type
			bne		doRowSort

doColSort
			ldx		S_CurBRSelect+2
			cpx		S_CurBRMost+2
			blt		doCol2

			ldx		S_CurBRMost+2

doCol2
			in		S_CurTLSelect:l,x:w,S_CurBRSelect:w,KeyCell:w
			XCall	S_DoColSort,err=ErrFlag
			bcc		redraw
			bra		memError

doRowSort
			ldx		S_CurBRSelect
			cpx		S_CurBRMost
			blt		doRow2

			ldx		S_CurBRMost

doRow2
			in		S_CurTLSelect:l,S_CurBRSelect+2:w,x:w,KeyCell+2:w
			XCall	S_DoRowSort,err=ErrFlag
			bcc		redraw

memError
			Call		D_MemoryError

redraw
			CmpWord	S_MoveSrcBR+2,S_MoveDestBR+2
			blt		chkLeft

			sta		S_MoveDestBR+2

chkLeft
			CmpWord	S_MoveSrcTL+2,S_MoveDestTL+2
			bge		doDraw

			sta		S_MoveDestTL+2

doDraw
			in		S_MoveDestTL:l,S_MoveDestBR:l
			XCall	S_RedrawCellRange

			Call		S_SetUndoOn,in=(#S_UndoSortType:w)

			lda		S_CurEditFlag
			and		#S_ManCalcBit
			bne		Exit

			Call		S_CalculateSheet

Exit
			RETURN
			ENDP

;-----------------------------------------------------------------------------
;
;

S_DoRowSort	PROC		EXPORT
			;Using	S_CurrentData

			input	FCol:w,FRow:w,LCol:w,LRow:w,KeyCol:w
			local	ArrayHandle:l,ArrayPtr:l,ArraySize:w,Count:w
			local	ArrayOffset:w,TargOffset:w,CurRow:w,CellPtr:l
			local	TargRow:w,SrcRow:w
			error	ErrorFlag
			BEGIN

			stz		ErrorFlag

			SubWord	LRow,FRow,a
			inc		a
			sta		Count

			asl		a
			asl		a
			sta		ArraySize

			in		#0:w,ArraySize:w
			out		ArrayHandle:l
			XCall	D_NeedHand,err=ErrorFlag
			jcs		Exit

	;	Set up the original array, filled with cell indices	;

			MoveLong	[ArrayHandle],ArrayPtr

			MoveWord	FRow,CurRow
			stz		ArrayOffset
			bra		startInit

initLoop
			inc		CurRow
			AddWord	ArrayOffset,#4,ArrayOffset

startInit
			in		KeyCol:w,CurRow:w
			out		[ArrayPtr]:ArrayOffset:l
			XCall	S_GetCellIndex

			ldy		ArrayOffset
			ora		[ArrayPtr],y
			bne		cmpInit

			tya
			sta		[ArrayPtr],y
			iny
			iny
			MoveWord	#$FF00,[ArrayPtr]:y

cmpInit
			CmpWord	CurRow,LRow
			blt		initLoop

	;	Sort the array	;

			in		#0:w,Count:w,ArrayHandle:l,#S_SortCompare:l
			XCall	D_Sort,err=ErrorFlag
			jcs		memError

	;	Renumber array for easy sorting	;

			MoveLong	[ArrayHandle],ArrayPtr

			stz		ArrayOffset

renumLoop
			ldy		ArrayOffset
			iny
			iny
			lda		[ArrayPtr],y
			bmi		cmpRenum

			H_GetBlockPtr	[ArrayPtr]:ArrayOffset,CellPtr

			SubWord	[CellPtr]:#S_CellID,FRow,a
			asl		a
			asl		a
			MoveWord	a,[ArrayPtr]:ArrayOffset

cmpRenum
			AddWord	ArrayOffset,#4,ArrayOffset

			CmpWord	ArrayOffset,ArraySize
			blt		renumLoop


			in		#0:w,FCol:w,FRow:w,LCol:w,LRow:w
			XCall	S_StartSortUndo


	;	Make Spreadsheet reflect the array	;

			stz		CurRow
			stz		ArrayOffset

swapLoop
			MoveLong	[ArrayHandle],ArrayPtr
			MoveWord	[ArrayPtr]:ArrayOffset,TargOffset

			cmp		ArrayOffset
			beq		cmpSwapEnd
			bge		doSwap

targLoop
			MoveWord	[ArrayPtr]:TargOffset,TargOffset

			cmp		ArrayOffset
			beq		cmpSwapEnd
			blt		targLoop

doSwap
			lsr		a
			lsr		a
			AddWord	a,FRow,TargRow

			AddWord	CurRow,FRow,SrcRow

			in		FCol:w,SrcRow:w,LCol:w,TargRow:w
			XCall	S_BuildSortUndo

			Call		S_SwapRows,in=(FCol:w,SrcRow:w,LCol:w,TargRow:w)

cmpSwapEnd
			inc		CurRow
			AddWord	ArrayOffset,#4,ArrayOffset

			CmpWord	a,ArraySize
			blt		swapLoop

memError
			Tool		_DisposeHandle,in=(ArrayHandle:l)

Exit
			RETURN
			ENDP

;-----------------------------------------------------------------------------
;
;

S_DoColSort	PROC		EXPORT
			;Using	S_CurrentData

			input	FCol:w,FRow:w,LCol:w,LRow:w,KeyRow:w
			local	ArrayHandle:l,ArrayPtr:l,ArraySize:w,Count:w
			local	ArrayOffset:w,TargOffset:w,CurCol:w,CellPtr:l
			local	TargCol:w,SrcCol:w
			error	ErrorFlag
			BEGIN

			stz		ErrorFlag

			SubWord	LCol,FCol,a
			inc		a
			sta		Count

			asl		a
			asl		a
			sta		ArraySize

			in		#0:w,ArraySize:w
			out		ArrayHandle:l
			XCall	D_NeedHand,err=ErrorFlag
			jcs		Exit

	;	Set up the original array, filled with cell indices	;

			MoveLong	[ArrayHandle],ArrayPtr

			MoveWord	FCol,CurCol
			stz		ArrayOffset
			bra		startInit

initLoop
			inc		CurCol
			AddWord	ArrayOffset,#4,ArrayOffset

startInit
			in		CurCol:w,KeyRow:w
			out		[ArrayPtr]:ArrayOffset:l
			XCall	S_GetCellIndex

			ldy		ArrayOffset
			ora		[ArrayPtr],y
			bne		cmpInit

			tya
			sta		[ArrayPtr],y
			iny
			iny
			MoveWord	#$FF00,[ArrayPtr]:y

cmpInit
			CmpWord	CurCol,LCol
			blt		initLoop

	;	Sort the array	;

			in		#0:w,Count:w,ArrayHandle:l,#S_SortCompare:l
			XCall	D_Sort,err=ErrorFlag
			jcs		memError

	;	Renumber array for easy sorting	;

			MoveLong	[ArrayHandle],ArrayPtr

			stz		ArrayOffset

renumLoop
			ldy		ArrayOffset
			iny
			iny
			lda		[ArrayPtr],y
			bmi		cmpRenum

			H_GetBlockPtr	[ArrayPtr]:ArrayOffset,CellPtr

			SubWord	[CellPtr]:#S_CellID+2,FCol,a
			asl		a
			asl		a
			MoveWord	a,[ArrayPtr]:ArrayOffset

cmpRenum
			AddWord	ArrayOffset,#4,ArrayOffset

			CmpWord	ArrayOffset,ArraySize
			blt		renumLoop


			Call		S_StartSortUndo,in=(#1:w,FCol:w,FRow:w,LCol:w,LRow:w)

	;	Make Spreadsheet reflect the array	;

			stz		CurCol
			stz		ArrayOffset

swapLoop
			MoveLong	[ArrayHandle],ArrayPtr
			MoveWord	[ArrayPtr]:ArrayOffset,TargOffset

			cmp		ArrayOffset
			beq		cmpSwap
			bge		doSwap

targLoop
			MoveWord	[ArrayPtr]:TargOffset,TargOffset

			cmp		ArrayOffset
			beq		cmpSwap
			blt		targLoop

doSwap
			lsr		a
			lsr		a
			AddWord	a,FCol,TargCol

			AddWord	CurCol,FCol,SrcCol

			in		SrcCol:w,FRow:w,TargCol:w,LRow:w
			XCall	S_BuildSortUndo

			Call		S_SwapColumns,in=(SrcCol:w,FRow:w,TargCol:w,LRow:w)

cmpSwap
			inc		CurCol
			AddWord	ArrayOffset,#4,ArrayOffset

			CmpWord	a,ArraySize
			blt		swapLoop

memError
			Tool		_DisposeHandle,in=(ArrayHandle:l)

Exit
			RETURN
			ENDP

;---------------------------------------------------------------------------
;	S_SortCompare ( CellIndex1:l,CellIndex2:l ) : bool:w
;
;	This routine compares the two cells contents according to
; S_SortAscendDescendFlag for the Sort routines.

S_SortCompare	PROC		EXPORT
			;Using	S_CurrentData
			;Using	S_SortData
			;Using	SANEequs

			input	CellIndex1:l,CellIndex2:l
			output	OneGreaterFlag:w
			local	CellPtr1:l,CellPtr2:l
			local	Cell1Error:w,Cell1NA:w,Cell1Value:w,Cell1Text:w
			local	Format:w
			BEGIN	+b

			stz		Cell1Error
			stz		Cell1NA
			stz		Cell1Value
			stz		Cell1Text

			lda		CellIndex1+2
			bmi		getCell2

			H_GetBlockPtr	CellIndex1,CellPtr1

			MoveWord	[CellPtr1]:#S_CellFormat,Format
			bmi		getCell2

			and		#S_CellInvalid
			beq		cell1OK

			lda		Format
			and		#S_CellError
			beq		doCell1NA

			inc		Cell1Error
			bra		getCell2

doCell1NA
			inc		Cell1NA
			bra		getCell2

cell1OK
			lda		Format
			and		#S_CellTypeValue
			bne		doCell1Value

			inc		Cell1Text
			bra		getCell2

doCell1Value
			inc		Cell1Value

getCell2
			lda		CellIndex2+2
			jmi		doTwoGreater

			H_GetBlockPtr	CellIndex2,CellPtr2

			MoveWord	[CellPtr2]:#S_CellFormat,Format
			bmi		doTwoGreater

			and		#S_CellInvalid
			beq		cell2OK

			lda		Format
			and		#S_CellError
			beq		doCell2NA

			lda		#0
			bra		doCell2Error

cell2OK
			lda		Format
			and		#S_CellTypeValue
			bne		chkCell2Value

			lda		Cell1Text
			beq		doCell2Text

			bra		doTextCmp

chkCell2Value
			lda		Cell1Value
			beq		doCell2Value

			AddLong	CellPtr1,#S_CellValue,s
			AddLong	CellPtr2,#S_CellValue,s

			lda		S_SortAscendDescendFlag
			beq		cmpValueAscend
			bra		cmpValueDescend

doCell2Error	ora		Cell1Error
doCell2NA		ora		Cell1NA
doCell2Value	ora		Cell1Value
doCell2Text	ora		Cell1Text

			bne		doTwoGreater

doOneGreater
			MoveWord	#1,OneGreaterFlag
			bra		Exit

doTwoGreater
			stz		OneGreaterFlag

Exit
			RETURN

cmpValueAscend
			Tool		FCPXX,in=(:l,:l)

			FBGT		doOneGreater
			bra		doTwoGreater

cmpValueDescend
			Tool		FCPXX,in=(:l,:l)

			FBLT		doOneGreater
			bra		doTwoGreater

doTextCmp
			SpaceWord
			H_GetBlockPtr	[CellPtr1]:#S_CellValue,s
			H_GetBlockPtr	[CellPtr2]:#S_CellValue,s
			Call			D_CmpStrings,in=(:l,:l,#0:w)		; out=(:w)

			lda		S_SortAscendDescendFlag
			beq		cmpTextAscend

cmpTextDescend
			pla
			bmi		doOneGreater
			bra		doTwoGreater

cmpTextAscend
			pla
			bmi		doTwoGreater
			beq		doTwoGreater
			brl		doOneGreater

			ENDP

;---------------------------------------------------------------------------
;	S_SwapColumns (TLCell:l,BRCell:l)
;
;	This routine traverses the first and last column of this given region
; and calls S_SwapCell if either of the two cells in a row is non-empty.

S_SwapColumns	PROC		EXPORT
			;Using	S_CurrentData
			;Using	S_MoveData

			input	Col1:w,FRow:w,Col2:w,LRow:w
			local	RowBlock:l,RowHandle:l,RowPtr:l
			local	RowBlockPtr:l,RowOffset:w
			local	Col1Flag:l,Col2Flag:l
			local	MinCol:w,MaxCol:w,MaxRow:w
			error	ErrorFlag
			BEGIN

			stz		ErrorFlag

			stz		S_DeltaMove
			SubWord	Col2,Col1,S_DeltaMove+2

			bra		startRow

	;	For each row in the range, ....	;

nextRow
			inc		FRow

startRow
			MoveLong	S_CurRowBlock,RowBlock
			ora		RowBlock
			jeq		Exit

			MoveLong	[RowBlock],RowBlockPtr
			MoveWord	[RowBlockPtr]:#S_KeyMax,MaxRow

			CmpWord	FRow,[RowBlockPtr]:#S_KeyMin
			blt		tooSmall

			cmp		MaxRow
			blt		okRow

			brl		Exit

tooSmall
			lda		[RowBlockPtr],y
			dec		a
			sta		FRow
			MoveWord	#S_KeyArray-4,RowOffset
			bra		searchRow

okRow
			SubWord	a,[RowBlockPtr]:y,a
			asl		a
			asl		a
			AddWord	a,#S_KeyArray,RowOffset

searchLoop
			MoveLong	[RowBlockPtr]:RowOffset,RowHandle
			ora		RowHandle
			bne		gotRow

searchRow
			inc		FRow
			AddWord	RowOffset,#4,RowOffset

			CmpWord	FRow,MaxRow
			bge		rowQuit

			CmpWord	LRow,FRow
			bge		searchLoop

rowQuit
			brl		Exit

gotRow
			MoveLong	[RowHandle],RowPtr
			MoveWord	[RowPtr]:#S_KeyMax,MaxCol
			MoveWord	[RowPtr]:#S_KeyMin,MinCol

			CmpWord	Col1,MinCol
			blt		noCol1

			cmp		MaxCol
			bge		noCol1

			CmpWord	Col2,MinCol
			blt		noCol2

			cmp		MaxCol
			blt		okCols

	;	No Col2, but Col1 is in structure	;

noCol2
			stz		Col2Flag
			bra		getCol1

noCol1
			CmpWord	Col2,MinCol
			blt		gotoEnd

			cmp		MaxCol
			blt		zeroCol1

gotoEnd
			brl		cmpRow

zeroCol1
			stz		Col1Flag
			bra		getCol2

okCols
			SubWord	a,MinCol,a
			asl		a
			asl		a
			AddWord	a,#S_KeyArray,y
			lda		[RowPtr],y
			iny
			iny
			ora		[RowPtr],y
			sta		Col2Flag

getCol1
			SubWord	Col1,MinCol,a
			asl		a
			asl		a
			AddWord	a,#S_KeyArray,y
			lda		[RowPtr],y
			iny
			iny
			ora		[RowPtr],y
			sta		Col1Flag
			bra		chkCols

getCol2
			SubWord	Col2,MinCol,a
			asl		a
			asl		a
			AddWord	a,#S_KeyArray,y
			lda		[RowPtr],y
			iny
			iny
			ora		[RowPtr],y
			sta		Col2Flag

chkCols
			lda		Col2Flag
			ora		Col1Flag
			beq		cmpRow


			Call		S_SwapCell,in=(Col1:w,FRow:w),err=ErrorFlag
			bcs		Exit

cmpRow
			CmpWord	FRow,LRow
			jlt		nextRow

Exit
			RETURN
			ENDP

;---------------------------------------------------------------------------
;	S_SwapRows (TLCell:l,BRCell:l)
;
;	This routine traverses the first and last rows of this given region
; and calls S_SwapCell if either of the two cells in a column is non-empty.

S_SwapRows	PROC		EXPORT
			;Using	S_CurrentData
			;Using	S_MoveData

			input	FCol:w,Row1:w,LCol:w,Row2:w
			local	RowIndex:l,RowPtr:l,ColIndex:l
			local	ColOffset:w,MaxCol:w
			local	RowBlock:l,RowBlockPtr:l
			local	NextCol1:w,NextCol2:w
			error	ErrorFlag
			BEGIN

			stz		ErrorFlag

			lda		S_CurRowBlock
			ora		S_CurRowBlock+2
			jeq		Exit

			SubWord	Row2,Row1,S_DeltaMove
			stz		S_DeltaMove+2

			stz		NextCol1
			stz		NextCol2

			bra		start

	;	For each cell in the row, ....	;

nextCol
			inc		FCol

start
			CmpWord	NextCol1,FCol
			blt		getCol1

			jeq		makeCall2
			brl		gotNextCol1

getCol1
			MoveLong	S_CurRowBlock,RowBlock
			MoveLong	[RowBlock],RowBlockPtr

			CmpWord	Row1,[RowBlockPtr]:#S_KeyMax
			bge		noRow1

			SubWord	a,[RowBlockPtr]:#S_KeyMin,a
			bge		row1InRange

noRow1
			brl		noMoreRow1

row1InRange
			asl		a
			asl		a
			AddWord	a,#S_KeyArray,y
			MoveLong	[RowBlockPtr]:y,RowIndex
			ora		RowIndex
			beq		noRow1

	;	Find first used Col Greater/Equal to FCol	;

			MoveLong	[RowIndex],RowPtr
			MoveWord	[RowPtr]:#S_KeyMax,MaxCol

			CmpWord	FCol,MaxCol
			bge		noRow1

			sta		NextCol1

			SubWord	a,[RowPtr]:#S_KeyMin,a
			bge		col1InRange

	;	Try Mincol as NextCol1	;

			lda		[RowPtr],y
			dec		a
			sta		nextCol1
			MoveWord	#S_KeyArray-4,ColOffset
			bra		startCol1Loop

col1InRange
			asl		a
			asl		a
			AddWord	a,#S_KeyArray,ColOffset

			tay
			MoveLong	[RowPtr]:y,ColIndex
			ora		ColIndex
			beq		startCol1Loop

			brl		makeCall2

findCol1Loop
			MoveLong	[RowPtr]:ColOffset,ColIndex
			ora		ColIndex
			bne		gotNextCol1

startCol1Loop
			inc		NextCol1
			AddWord	ColOffset,#4,ColOffset

			CmpWord	NextCol1,MaxCol
			bge		noMoreRow1

			CmpWord	LCol,NextCol1
			bge		findCol1Loop

noMoreRow1
			AddWord	LCol,#1,NextCol1

gotNextCol1
			CmpWord	NextCol2,FCol
			jge		chkFCol

			MoveLong	S_CurRowBlock,RowBlock
			MoveLong	[RowBlock],RowBlockPtr

			CmpWord	Row2,[RowBlockPtr]:#S_KeyMax
			bge		noRow2

			SubWord	a,[RowBlockPtr]:#S_KeyMin,a
			bge		row2InRange

noRow2
			brl		noMoreRow2

row2InRange
			asl		a
			asl		a
			AddWord	a,#S_KeyArray,y
			MoveLong	[RowBlockPtr]:y,RowIndex
			ora		RowIndex
			beq		noRow2

	;	Find first used Col Greater/Equal to FCol	;

			MoveLong	[RowIndex],RowPtr
			MoveWord	[RowPtr]:#S_KeyMax,MaxCol

			CmpWord	FCol,MaxCol
			bge		noRow2

			sta		NextCol2

			SubWord	a,[RowPtr]:#S_KeyMin,a
			bge		col2InRange

	;	Try MinCol as the next col	;

			lda		[RowPtr],y
			dec		a
			sta		nextCol2
			MoveWord	#S_KeyArray-4,ColOffset
			bra		startCol2Loop

col2InRange
			asl		a
			asl		a
			AddWord	a,#S_KeyArray,ColOffset

			tay
			MoveLong	[RowPtr]:y,ColIndex
			ora		ColIndex
			beq		startCol2Loop

			bra		makeCall2

findCol2Loop
			MoveLong	[RowPtr]:ColOffset,ColIndex
			ora		ColIndex
			bne		chkFCol

startCol2Loop
			inc		NextCol2
			AddWord	ColOffset,#4,ColOffset

			CmpWord	NextCol2,MaxCol
			bge		noMoreRow2

			CmpWord	LCol,NextCol2
			bge		findCol2Loop

noMoreRow2
			AddWord	LCol,#1,NextCol2

chkFCol
			CmpWord	NextCol1,NextCol2
			bge		chkRow2

			cmp		LCol
			beq		makeCall1
			blt		makeCall1
			bra		Exit

chkRow2
			CmpWord	NextCol2,LCol
			beq		makeCall1
			bge		Exit

makeCall1
			sta		FCol

makeCall2
			Call		S_SwapCell,in=(FCol:w,Row1:w),err=ErrorFlag
			bcs		Exit

			CmpWord	FCol,LCol
			bge		Exit

			brl		nextCol

Exit
			RETURN
			ENDP
			END