Apple-2-SW/antoine-source
1
0
Fork 0
mirror of https://github.com/antoinevignau/source.git synced 2024-06-13 02:29:35 +00:00
Code Issues Projects Releases Wiki Activity
main
antoine-source/appleworksgs/SS/Src/Sort.aii
Antoine Vignau 5fef614692 First release
2023-03-04 03:45:20 +01:00

1 line
16 KiB
Plaintext
Executable File
Raw Permalink Blame History

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
Reference in New Issue View Git Blame Copy Permalink