antoine-source/appleworksgs/WP/Src/Tools.aii
2023-03-04 03:45:20 +01:00

1 line
22 KiB
Plaintext
Executable File
Raw Permalink Blame History

load 'macros.dump'
include 'driver.equ'
include 'wp.equ'
;-----------------------------------------------
;
; Imported addresses
;
;-----------------------------------------------
IMPORT X_AsciitoWPScrap
IMPORT W_BackChar
IMPORT D_BeachBall
IMPORT W_CalcDocRect
IMPORT CaretOff
IMPORT W_CaretOn
IMPORT W_CurDoc
IMPORT W_DeleteRange
IMPORT W_DeleteText
IMPORT W_EndLine
IMPORT W_EndOffset
IMPORT W_EndPar
IMPORT W_FindLine
IMPORT W_GetAddr
IMPORT W_GetBegLine
IMPORT W_GetEndLine
IMPORT W_GetLRecPtr
IMPORT W_InvSelect
IMPORT D_IsDigit
IMPORT D_IsLetter
IMPORT W_LineToTopPixel
IMPORT D_MainZPage
IMPORT W_MakeLines
IMPORT D_NeedHandle
IMPORT W_PasteAscii
IMPORT W_PasteText
IMPORT W_PutOnScreen
IMPORT W_ScrollBar
IMPORT W_SelectOff
IMPORT W_SelectOn
IMPORT D_SetFileChanged
IMPORT W_SetFullREct
IMPORT W_StartLine
IMPORT W_StartOffset
IMPORT W_StartPar
IMPORT W_UndoHandle
IMPORT W_UndoOff
IMPORT W_UndoOn
IMPORT W_UpdateDoc
IMPORT W_UpdateText
IMPORT W_WpCopy
IMPORT W_addr
IMPORT W_Char
IMPORT W_Hand
IMPORT D_IsAlphaNum
IMPORT D_ToLowerTable
IMPORT D_ToUpperTable
IMPORT W_LastP
IMPORT W_Ptr
IMPORT D_State
;-----------------------------------------------
;
; Forward addresses and entries
;
;-----------------------------------------------
ENTRY W_ChangeCase
ENTRY InWord
ENTRY W_IsSpace
ENTRY W_SelectText
********************************************************************
*
* Includes...
* Wednesday, May 3, 1989 12:56:43 AM
********************************************************************
W_ToolData PROC EXPORT
EXPORT W_AvailEvent
EXPORT W_AEKey
EXPORT W_AEKeyWhen
EXPORT W_AEModFlags
EXPORT W_GetEvent
EXPORT W_GEKey
EXPORT W_GEKeyWhen
EXPORT W_GEModFlags
W_AvailEvent
DS.B 2
W_AEKey DS.B 4
W_AEKeyWhen DS.B 4
DS.B 4
W_AEModFlags DS.B 2
W_GetEvent
DS.B 2
W_GEKey DS.B 4
W_GEKeyWhen DS.B 4
DS.B 4
W_GEModFlags DS.B 2
ENDP
****************************************************************
* W_KillKey(W_Key) gets rid of all up current
W_KillKey PROC EXPORT
;Using W_ToolData
input InKey:w
local W_Time:l
begin
pha
pushword #%101000 ;W_Key down and auto
pushlong #W_AvailEvent
_EventAvail
pla
jeq KKDone
cmpw InKey,W_AEKey
jne KKDone
Loop1
pha
pushword #%101000 ;W_Key down and auto
pushlong #W_AvailEvent
_EventAvail
pla
beq DoneLoop1
cmpw InKey,W_AEKey
jne KKDone
pha
pushword #%101000 ;W_Key down and auto
pushlong #W_GetEvent
_GetNextEvent
pla
bra Loop1
DoneLoop1
spacelong
_TickCount
pullLong W_Time
pha
pushword #3
pushword W_GEModFlags
pushword InKey
_PostEvent
pla
Loop2
pha
pushword #%101000 ;W_Key down and auto
pushlong #W_AvailEvent
_EventAvail
pla
cmpw InKey,W_AEKey
bne RePostIt
cmpl W_AEKeyWhen,W_Time
bcs DoneLoop2
RePostIt
pha
pushword #%101000 ;W_Key down and auto
pushlong #W_GetEvent
_GetNextEvent
pla
pha
pushword #3
pushword W_GEModFlags
pushword W_GEKey
_PostEvent
pla
brl Loop2
DoneLoop2
KKDone
return
ENDP
****************************************************************
* W_NextCharBack(par,line,W_offset):offsetToChar,OffsetToSpace
W_NextCharBack PROC EXPORT
input par:w,_Line:w,W_offset:w
local ChrPtr:l,LineRecPtr:l
output CharOffset:w,SpaceOffset:w
begin
spacelong
pushword par
pushword _Line
jsl W_GetLRecPtr
pullLong LineRecPtr
lda par
ldx #0
jsl W_GetAddr
movelong ax,ChrPtr
moveword [LineRecPtr]:#W_lOffset,CharOffset
sta SpaceOffset
cmpw CharOffset,W_offset
jeq GotChar
ldy CharOffset
Loop lda [ChrPtr],y
and #$ff
cmp #sp
bcs NotControl
asl a
tax
jmp (ChrTable,x)
ChrTable DC.W 0,Skip2 ;0,1
DC.W Skip1,Skip1 ;2,3
DC.W Skip1,NotSpace ;4,5
DC.W NotSpace,NotSpace ;6,7
DC.W 0,GotSpace ;8,9
Skip2 iny
Skip1 iny
bra PastChar
NotControl
jsl W_IsSpace
bcc NotSpace
GotSpace
sty SpaceOffset
NotSpace sty CharOffset
PastChar iny
cpy W_offset
bcs GotChar
brl Loop
GotChar
return
ENDP
****************************************************************
* W_IsSpace(W_Char:a) - cs for yes its a space
* cc for no space
W_IsSpace PROC EXPORT
cmp #sp
beq GSpace
cmp #tab
beq GSpace
cmp #13
beq GSpace
clc
GSpace rtl
ENDP
****************************************************************
*
* W_WordBounds(a,x) -> a,x,y -- determine the boundaries
* of the word containing the character at a,x. 'Word'
* is explicitly defined in Apple's Human Interface
* Guidelines, with the exception that words are
* necessarily confined to a single line.
*
* INPUTS:
* a = paragraph number
* x = W_offset
* OUTPUTS:
* a = paragraph number
* x = starting W_offset
* y = ending W_offset
*
****************************************************************
W_WordBounds PROC EXPORT
;Using D_GlobalData
;Using WPGlobals
EXPORT inWord
W_addr equ 0 ; address of current paragraph
W_offset equ 4 ; starting offset of NEXT word
W_started equ 6 ; Am I in the middle of a word?
sta W_par
stx W_off
spaceword ; get various pieces of line data
pushword W_par
pushword W_off
jsl W_FindLine
pullword W_line
spaceword
pushword W_par
pushword W_line
jsl W_GetBegLine
pullword W_startoff
spaceword
pushword W_par
pushword W_line
jsl W_GetEndLine
pullword W_lastoff
lda W_par
ldx #0
jsl W_GetAddr
tay ; FINALLY set the new direct page!!
phd
lda >D_MainZPage
tcd
tya
movelong ax,W_addr ; initialize some dynamic locals...
moveword W_startoff,W_offset
stz W_started
dec W_offset ; ...and start looking
jsr nextchar
cmp #13 ; CR?
jeq gotword
*--------------------------------------------------------------*
* Loop through the characters in the current line ;
*--------------------------------------------------------------*
cloop jsl InWord
bcs notnormal
stz gotletter
stz gotnumber
jsl D_IsLetter
bcs notletter
inc gotletter
bra notnumber
notletter jsl D_IsDigit
bcs notnumber
inc gotnumber
notnumber lda W_started ; am I in the middle of a word?
jne getnext
inc W_started ; if not, I am now!
bra gotstart
notnormal cmp #''''
beq @1
cmp #'<27>'
bne notapostrophe
@1
lda gotnumber
ora gotletter
beq alone
pushword W_offset
jsr nextchar
jsl D_IsDigit
bcc @pullit
jsl D_IsLetter
@pullit pullword W_offset ; doesn't affect the carry flag.
bcc getnext
bra alone
notapostrophe cmp #'.'
bne notperiod
pushword W_offset
jsr nextchar
jsl D_IsDigit
pullword W_offset ; doesn't affect C bit
bcs alone
lda W_started
bne getnext
inc W_started
bra gotstart
notperiod
cmp #','
bne notcomma
lda gotnumber
beq alone
pushword W_offset
jsr nextchar
jsl D_IsDigit
pullword W_offset ; doesn't affect C bit
bcc getnext
bra alone
notcomma
cmp #$CA ; non-breaking space.
bne alone
lda W_started
bne getnext
inc W_Started
bra gotstart
alone stz W_started
gotstart ldy W_offset
cpy W_off
bgt gotword
sty W_startoff
getnext ldy W_offset
cpy W_lastoff ; have I reached the end of the line?
bgt gotword ; if so, stop no matter what.
jsr nextchar
cmp #13 ; repeat unless at the end of the
jne cloop ; current paragraph.
gotword lda W_par
ldx W_startoff
ldy W_offset
pld
rtl
W_par DS.B 2 ; paragraph number passed in A
W_off DS.B 2 ; W_offset passed in Xl
W_line DS.B 2 ; current line number
W_startoff DS.B 2 ; starting offset of word
W_lastoff DS.B 2 ; Offset to the last char in the line
*--------------------------------------------------------------*
* Get the next REAL character, and update offset ;
*--------------------------------------------------------------*
nextchar inc W_offset
ldy W_offset
lda [W_addr],y
and #$ff
cmp #5
bge gotnext
cmp #1
bne skip1
inc W_offset
skip1 inc W_offset
bra nextchar
gotnext rts
*--------------------------------------------------------------*
* Can the char in A be part of a word (no matter what)? ;
*--------------------------------------------------------------*
inWord ;
jsl D_IsAlphaNum
jcc yes_w
cmp #'-'
beq yes_w
cmp #'$'
beq yes_w
cmp #'%'
beq yes_w
cmp #'<27>'
beq yes_w
cmp #'<27>'
beq yes_w
cmp #'<27>'
beq yes_w
cmp #'<27>'
beq yes_w
sec
rtl
yes_w clc
rtl
long
*--------------------------------------------------------------*
* stuff used above ;
*--------------------------------------------------------------*
gotletter DS.B 2
gotnumber DS.B 2
ENDP
****************************************************************
*
* W_lowercase -- make all selected letters lower case
* UPPERCASE -- capitalize all selected letters
* W_Capitalize -- make the first letter in any word UPPER case
* and any other letter lower case
*
* NOTE: These routines naturally assume something is selected.
*
****************************************************************
W_lowercase PROC EXPORT
;Using WPGlobals
EXPORT UPPERCASE
EXPORT W_Capitalize
EXPORT W_ChangeCase
W_lower equ 0
W_UPPER equ 1
W_Capit equ 2
moveword #W_lower,>what
bra W_ChangeCase
UPPERCASE ;
moveword #W_UPPER,>what
bra W_ChangeCase
W_Capitalize ;
moveword #W_Capit,>what
*--------------------------------------------------------------*
* That was fun. Now do the work. ;
*--------------------------------------------------------------*
W_ChangeCase ;
local par:w,off:w,W_Char:w,W_addr:l
local first:w,_rect:r
begin +b
pushlong W_CurDoc
jsl D_SetFileChanged
pushword #W_CaseUndo
jsl W_UndoOn
spacelong
pushword W_StartPar
pushword W_StartLine
pushword W_StartOffset
pushword W_EndPar
pushword W_EndLine
pushword W_EndOffset
jsl W_WpCopy
pulllong W_UndoHandle
lda W_StartPar
ldx #0
jsl W_GetAddr
movelong ax,W_addr
moveword W_StartOffset,off
moveword W_StartPar,par
cmpw what,#W_Capit
bne startloop
stz first
spaceword
spaceword
spaceword
pushword W_StartPar
pushword W_StartLine
pushword W_StartOffset
jsl W_BackChar
plx ; offset
ply ; Line
pla ; par
cmp W_StartPar
bne itsfirst
cpx W_StartOffset
beq itsfirst
jsl W_GetAddr ; (ax = D_New par/off still)
movelong ax,_Rect
lda [_Rect]
and #$ff ; get the previous character
jsl W_IsSpace ; if it's a space...
bcc startloop
itsfirst inc first ; ...then this begins a word!
bra startloop
*--------------------------------------------------------------*
* Loop through the selected characters ;
*--------------------------------------------------------------*
loop cmpw W_Char,#13 ; am I done with this paragraph?
bne samepar
pushword par ; recompute its line info
jsl W_MakeLines
inc par ; and get the next par's address
lda par
ldx #0
jsl W_GetAddr
movelong ax,W_addr
moveword #W_TextHeader-1,off
jsl D_BeachBall
samepar inc off ; get the next character
startloop ldy off
lda [W_addr],y
and #$ff
cmp #5
bge gotnext
cmp #1
bne skip1
inc off
skip1 inc off
bra samepar
gotnext sta W_Char
cmpw par,W_EndPar ; Have I reached the last W_offset?
blt checkchar
cmpw off,W_EndOffset
jge done
checkchar
lda W_Char
jsl W_IsSpace
bcs isspace
tax
ldy what ; It's a letter.
cpy #W_UPPER ; which case should it be?
beq up
cpy #W_lower
beq down
ldy first
bne up
down lda >D_ToLowerTable,x ; W_lower case
bra cased
up lda >D_ToUpperTable,x ; W_UPPER case
cased sta W_Char ; now put the letter back into the text
ldy off
shortm
sta [W_addr],y
longm
stz first
brl loop
isspace moveword #1,first ; it's a space
brl loop
*--------------------------------------------------------------*
* Now clean up and D_Update ;
*--------------------------------------------------------------*
done pushlong W_CurDoc
_SetPort
pushword par ; recompute line W_Stuff for last par
jsl W_MakeLines
pushlong !_Rect
jsl W_CalcDocRect
spacelong ; D_Update the text from the first
pushword W_StartPar ; W_Selected line onward
pushword W_StartLine
jsl W_LineToTopPixel
pla
pullword _rect
pushlong !_Rect
_ClipRect
pushlong !_Rect
_EraseRect
jsl W_UpdateText
jsl W_SetFullREct
return
what DS.B 2
ENDP
****************************************************************
*
* W_SelSentence -- select the current sentence.
*
****************************************************************
W_SelSentence PROC EXPORT
;Using WPglobals
local paddr:l,D_State:w,gotsp:w
local soff:w,eoff:w,temp:w
begin +b
jsl W_UndoOff
lda W_StartPar
ldx #0
jsl W_GetAddr
movelong ax,paddr
moveword #1,gotsp
stz D_State ; 0 = look for start, 1 = look for end
moveword #W_TextHeader,soff
moveword W_StartOffset,eoff
ldy #W_TextHeader
loop lda [paddr],y ; first, find the beginning of the
and #$ff ; sentence.
beq next
cmp #5
bge real
cmp #1
bne skip1
iny
skip1 iny
next iny
cpy W_StartOffset ; stop when D_State=0 and y>W_StartOffset
ble loop
lda D_State
bne loop
brl gotsent
real cmp #13 ; return?
beq gotend
cmp #9 ; tab?
beq gotend
cmp #$20 ; space?
beq @space
bra gotbeg ; must be something else!
@space ldx gotsp ; Is this my first space?
bne gotend
inc gotsp
sty temp ; Remember the W_offset....
bra next
gotend lda D_State ; Am I looking for the end?
jeq next
ldx temp ; ...for here. The trailing space
beq skipspace ; isn't part of the sentence.
txy ; (back up for termination test)
skipspace sty eoff
stz D_State
brl next
gotbeg stz gotsp ; it was something visible.
stz temp
ldx D_State
jne next
inc D_State
sty soff
brl next
*--------------------------------------------------------------*
gotsent cmpw eoff,W_StartOffset
ble exit
pushword W_StartPar
spaceword
pushword W_StartPar
pushword soff
jsl W_FindLine
pushword soff
pushword W_StartPar
spaceword
pushword W_StartPar
pushword eoff
jsl W_FindLine
pushword eoff
pushlong #0
jsl W_SelectText
jsl W_InvSelect
exit return
ENDP
****************************************************************
*
* W_SelectText(spar,slin,soff,epar,elin,eoff,rect) -- deselect
* old text, make new text visible and select it, BUT
* DON'T INVERT IT!!
*
****************************************************************
W_SelectText PROC EXPORT
;Using WPGlobals
input spar:w,slin:w,soff:w
input epar:w,elin:w,eoff:w
input rectptr:l
begin
spacelong
_GetPort
pushlong W_CurDoc
_SetPort
jsl W_SetFullREct
pushword epar ; Make sure both lines are visible
pushword elin
pushlong rectptr
jsl W_PutOnScreen
pushword spar
pushword slin
pushlong rectptr
jsl W_PutOnScreen
jsl CaretOff ; turn off the caret, or
jsl W_SelectOff ; deselect the old text
moveword spar,W_StartPar ; select the new text
moveword slin,W_StartLine
moveword soff,W_StartOffset
moveword epar,W_EndPar
moveword elin,W_EndLine
moveword eoff,W_EndOffset
cmpw soff,eoff
bne selectit
cmpw slin,elin
bne selectit
cmpw spar,epar
bne selectit
jsl W_CaretOn
bra done
selectit jsl W_SelectOn ; and tell D_WP about it
done _SetPort ; restore the port
return
ENDP
****************************************************************
*
* W_StrToWPScrap(strptr:l) -- return a W_Handle on a D_WP scrap
* containing the text in the given Pascal string.
* Removes display characters for W_FindReplace, and
* probably shouldn't.
*
****************************************************************
W_StrToWPScrap PROC EXPORT
input strptr:l
output wphand:l
local rhand:l,rptr:l
begin
lda [strptr]
and #$ff
bne sometext
movelong #0,wphand
brl exit
sometext spacelong
pushword #0
lda [strptr]
and #$ff
pha
pushword #$8000
jsl D_NeedHandle
pulllong rhand
movelong [rhand],rptr
addlong strptr,#1,s
pushlong rptr
pushword #0
lda [strptr]
and #$ff
pha
_BlockMove
spacelong
pushlong rhand
jsl X_AsciitoWPScrap
pulllong wphand
pushlong rhand
_DisposeHandle
exit return
ENDP
****************************************************************
*
* W_PasteStr(strptr:l) -> epar:w,elin:w,eoff:w,pasted:w
* Pastes a Pascal string in place of the current
* selection. If the string is empty, just deletes
* the selection. Filters bogus chars out of the
* string.
*
****************************************************************
W_PasteStr PROC EXPORT
;Using WPGlobals
input strptr:l
output epar:w,elin:w,eoff:w,pasted:w
local spar:w,slin:w,soff:w
local scrap:l,recut:w,slow:w
begin
stz pasted
stz recut
moveword W_StartPar,spar
moveword W_StartLine,slin
moveword W_StartOffset,soff
pushlong W_CurDoc
_SetPort
jsl W_SelectOff
cmpw W_StartPar,W_EndPar ; more than one paragraph W_Selected?
bne diffpars
pushword spar ; if not, do it quick
pushword soff
pushword W_EndOffset
jsl W_DeleteText
inc recut
bra no_select
diffpars spaceword ; otherwise, do it slow (snore)
spaceword
spaceword
pushword sPar
pushword slin
pushword soff
pushword W_EndPar
pushword W_EndLine
pushword W_EndOffset
jsl W_DeleteRange
pullword soff
pullword slin
pullword spar
no_select lda [strptr] ; anything to paste?
and #$ff
jeq empty
stz slow
tay ; filter out bogus chars and look
short ; for CR's...
floop lda [strptr],y
cmp #13
bne notcr
inc slow
bra _ok_
notcr cmp #9
beq _ok_
cmp #' '
bge _ok_
lda #' '
sta [strptr],y
_ok_ dey
bne floop
long
lda slow
jne X_GetScrap
addlong strptr,#1,s ; if not, use the fast W_Stuff.
lda [strptr]
and #$ff
pha
pushword spar
pushword soff
jsl W_PasteAscii
moveword spar,epar
lda [strptr]
and #$ff
clc
adc soff
sta eoff
pushword spar ; recut the paragraph
jsl W_MakeLines
spaceword ; and find the required line numbers
pushword spar
pushword soff
jsl W_FindLine
pullword slin
spaceword
pushword spar
pushword eoff
jsl W_FindLine
pullword elin
inc pasted
brl exit
empty moveword spar,epar ; It's empty -- nothing to paste.
moveword slin,elin
moveword soff,eoff
lda recut
jeq exit
pushword W_StartPar
jsl W_MakeLines
spaceword
pushword spar
pushword soff
jsl W_FindLine
pullword slin
moveword slin,elin
brl exit
X_GetScrap spacelong ; It's weird. Do it slow.
pushlong strptr
jsl W_StrToWPScrap
pulllong scrap
lda recut
beq norecut
pushword spar
jsl W_MakeLines
spaceword
pushword spar
pushword soff
jsl W_FindLine
pullword slin
norecut spaceword
spaceword
spaceword
pushlong scrap
pushword spar
pushword slin
pushword soff
jsl W_PasteText
pullword eoff
pullword elin
pullword epar
inc pasted
exit return
ENDP
****************************************************************
*
* W_UpdateAfter(par:w,lin:w) -- D_Update everything in the window
* following a given paragraph and line
*
****************************************************************
W_UpdateAfter PROC EXPORT
;Using WPGlobals
input par:w,lin:w
local _Rect:r
begin
spacelong
_GetPort
pushlong W_CurDoc
_SetPort
pushlong !_Rect
jsl W_CalcDocRect
spacelong ; Update the text from the first
pushword par ; selected line onward
pushword lin
jsl W_LineToTopPixel
pla
pla ; Is it above the top of the
cmp _Rect ; doc rect??
blt gotit ; If so, don't change anything.
sta _Rect
gotit pushlong !_Rect
_InvalRect
pushlong W_CurDoc
_BeginUpdate
pushlong W_CurDoc
jsl W_UpdateDoc
pushlong W_CurDoc
_EndUpdate
_SetPort
return
ENDP
****************************************************************
*
* W_RecutDoc -- recut every paragraph in the W_Document
*
****************************************************************
W_RecutDoc PROC EXPORT
;Using WPGlobals
local par:w
begin
moveword #1,par ; recut all the paragraphs (might not
parloop pushword par ; be necessary!)
jsl W_MakeLines
inc par
cmpw par,W_LastP
ble parloop
return
ENDP
****************************************************************
*
* W_FindFont2(par:w,W_offset:w) -> font:l,color:w -- Same as
* W_FindFont, but without using line handles
*
****************************************************************
W_FindFont2 PROC EXPORT
;Using WPglobals
input par:w,W_offset:w
local W_addr:l
output font:l,color:w
begin
lda par
ldx #0
jsl W_GetAddr
movelong ax,W_addr
movelong [W_addr],font
moveword [W_addr]:#4,color
ldy #W_TextHeader
ChrLoop cpy W_offset
jeq exit
lda [W_addr],y
and #$ff
iny
cmp #sp
bcs ChrLoop
asl a
tax
jmp (ChrTable,x)
ChrTable DC.W 0,FChange ; 0,1
DC.W StyleChange,SizeChange ; 2,3
DC.W ColorChange,ChrLoop ; 4,5
DC.W ChrLoop,ChrLoop ; 6,7
DC.W 0,ChrLoop ; 8,9
DC.W 0,0 ; a,b
DC.W 0,ChrLoop ; c,d
FChange lda [W_addr],y
sta font
iny
iny
brl ChrLoop
SizeChange lda [W_addr],y
shortm
sta font+3
longm
iny
brl ChrLoop
StyleChange lda [W_addr],y
shortm
sta font+2
longm
iny
brl ChrLoop
ColorChange lda [W_addr],y
sta color
iny
brl ChrLoop
exit return
ENDP
****************************************************************
*
* W_InvalScroll
*
****************************************************************
W_InvalScroll PROC EXPORT
;Using ScreenData
;Using WpGlobals
local W_Hand:l,W_Ptr:l,_Rect:r
begin +b
pushlong W_CurDoc
_SetPort
movelong W_ScrollBar,W_Hand ; Invalidate the scroll bar
Movelong [W_Hand],W_Ptr ; (Oliverian hackle!)
movelong [W_Ptr]:#8,_Rect
movelong [W_Ptr]:#12,_Rect+4
addword _Rect+4,#W_PNumBoxHt,_Rect+4
subword _Rect,#W_PNumBoxHt,_Rect
pushlong !_Rect
_InvalRect
return
ENDP
END