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

1 line
15 KiB
Plaintext
Executable File
Raw Permalink Blame History

load 'macros.dump'
include 'driver.equ'
include 'scrap.equ'
include 'dbsc.equ'
include 'sssc.equ'
IMPORT D_BeachBall
IMPORT D_CurCursor
IMPORT X_DefHeader
IMPORT FieldRecSize
IMPORT D_GrowHandle
IMPORT D_GrowLHandle
IMPORT D_NeedHandle
IMPORT X_OldCursor
IMPORT D_SetCursor
import X_ClipData
import X_CurHeader
import X_SwitchFont
import X_ParBlockSize
import D_Deref
import D_NeedHand
import X_FormatValue
import D_Unlock
X_ScDBtoPLScrap PROC EXPORT
;Using X_DBScrapData
;Using X_ClipData
;Using X_SWScrapEquates
;Using D_CursorData
input Src:l
local Sptr:l,Columns:w,Dptr:l,Dsize:l,Doff:l
local DataPtr:l,FieldPtr:l,Coldex:w,Cells:l
local CurFieldPtr:l,RowHeaderSize:w,StrSize:w
local StyleChanged:w,ColorChanged:w,PLSize:l
local PLFlag:w,Temp:l
output Dest:l
error err
begin
MoveWord >D_CurCursor,X_OldCursor
stz err
;Set up default header
PushLong #X_DefHeader
PushLong #X_CurHeader
PushLong #7
_BlockMove
SpaceLong
_MaXBlock
PullLong Dsize
SpaceLong
PushLong Dsize
PushWord #$8000
jsl D_NeedHandle
sta err
PullLong Dest
jcs exit
;Now lock source down
PushLong Src
_HLock
;Dereference all of the handles and initialize things
MoveLong [Src],Sptr
MoveLong [Dest],Dptr
Stzl Dsize
Stzl Doff
AddLong Sptr,#X_DBScHeaderSize,FieldPtr
AddLong Sptr,[Sptr]:#X_DBDataOffset,DataPtr
MoveWord [Sptr]:#X_DBColumns,Columns
;Output the first paragraph header.
lda #7
jsr FixDptr
PushLong #X_CurHeader
PushLong Dptr
PushLong #7
_BlockMove
Addwl #7,Doff
;If we have field headers only, we want to convert the text. Otherwise,
;we don't. So here we check and branch if we want to do this.
lda [Sptr]
asl a
tax
jmp (scraptypetable,x)
scraptypetable
DC.W fieldheaders,docolumns,dorows,docells,docells
docolumns
dorows
docells
;Figure out how many cells we have
cont1 SpaceLong
PushWord [Sptr]:#X_DBRows
PushWord Columns
_Multiply
PullLong Cells
Cpzl Cells
bne notempty
AddLong [Dest],#7,Dptr
shortm
lda #CR
sta [DPtr]
longm
brl done
notempty
stz Coldex
MoveLong FieldPtr,CurFieldPtr
;I don't care about the junk at the beginning of a row.
stz StyleChanged
stz ColorChanged
stz PLFlag
;Now we actually read the data and copy it. This is icky.
; Spin the beach ball. Get the cell status word. If cell is empty leave after bumping pointer past
; the status word. If cell is not empty then branch based on field type to read cell contents.
loop jsl D_BeachBall
lda [DataPtr]
tax
addwl #2,DataPtr
cpx #X_DBCellEmpty
jeq endcell
ldy #X_DBFType
lda [CurFieldPtr],y
asl a
tax
jmp (TypeTable,x)
TypeTable
DC.W text,numeric,date,time,picture,pltext2
text
;Do formatting
ldy #X_DBFColor
lda [CurFieldPtr],y
jeq checkstyle
xba
ora #X_FontColor
pha
lda #2
jsr FixDptr
pla
jcs error
sta [Dptr]
Addwl #2,Doff
inc ColorChanged
checkstyle
ldy #X_DBFStyle
lda [CurFieldPtr],y
and #%0000000000000111
jeq text2
xba
ora #X_FontStyle
pha
lda #2
jsr FixDptr
pla
jcs error
sta [Dptr]
Addwl #2,Doff
inc StyleChanged
;Do text
text2 lda [DataPtr]
and #$ff
sta StrSize
jsr FixDptr
jcs error
Addwls #1,DataPtr
PushLong Dptr
pea 0
PushWord StrSize
_BlockMove
Addwl StrSize,Doff
Addwl StrSize,DataPtr
IncLong DataPtr
lda ColorChanged
beq nocolorchange
lda #2
jsr FixDptr
jcs error
lda #X_FontColor
sta [Dptr]
Addwl #2,Doff
stz ColorChanged
nocolorchange
lda StyleChanged
jeq endcell
lda #2
jsr FixDptr
jcs error
lda #X_FontStyle
sta [Dptr]
Addwl #2,Doff
stz StyleChanged
brl endcell
numeric Addwl #10,DataPtr
brl text
date Addwl #4,DataPtr
brl text
time Addwl #4,DataPtr
brl text
picture MoveLong [DataPtr],PLSize
Addwl #4,DataPtr
AddLong DataPtr,PLSize,DataPtr
brl endcell
pltext2 Cmpl Doff,#7
jne crhere
Stzl Dsize
Stzl Doff
brl getplhandle
crhere lda #1
jsr FixDptr
jcs error
short
lda #CR
sta [Dptr]
long
IncLong Doff
getplhandle
MoveLong [DataPtr],PLSize
jsr FixDptr2
jcs error
Addwl #4,DataPtr
PushLong DataPtr
PushLong Dptr
PushLong PLSize
_BlockMove
AddLong Doff,PLSize,Doff
AddLong DataPtr,PLSize,DataPtr
lda #7
jsr FixDptr
jcs error
PushLong #X_CurHeader
PushLong Dptr
PushLong #7
_BlockMove
Addwl #7,Doff
inc PLFlag
endcell inc Coldex
lda Coldex
cmp Columns
jlt notendofrow
lda #1
jsr FixDptr
jcs error
short
lda #CR
sta [Dptr]
long
IncLong Doff
stz Coldex
MoveLong FieldPtr,CurFieldPtr
DecLong Cells
jne putheader
lda Cells+2
jeq done
putheader
lda #7
jsr FixDptr
jcs error
PushLong #X_CurHeader
PushLong Dptr
PushLong #7
_BlockMove
Addwl #7,Doff
brl loop
notendofrow
AddLong CurFieldPtr,[CurFieldPtr],Temp
MoveLong Temp,CurFieldPtr
dodec DecLong Cells
lda PLFlag
bne clearpl
lda #1
jsr FixDptr
jcs error
short
lda #Tab
sta [Dptr]
long
IncLong Doff
brl loop
clearpl stz PLFlag
brl loop
fieldheaders
stz Coldex
AddWord [Sptr]:#X_DBLabels,Columns,Columns
lda Columns
jeq done
headloop MoveWord [FieldPtr]:#X_DBFType,a
cmp #9
jlt notlabel
lda #(EndLabel-Label)
jsr FixDptr
jcs error
PushLong #Label
PushLong Dptr
PushLong #EndLabel-Label
_BlockMove
Addwl #(EndLabel-Label),Doff
brl doheadinc
Label DC.B '<Label>'
EndLabel
notlabel
ldy #FieldRecSize
lda [FieldPtr],y
and #$ff
sta StrSize
jsr FixDptr
jcs error
Addwls #(FieldRecSize+1),FieldPtr
PushLong Dptr
pea 0
PushWord StrSize
_BlockMove
Addwl StrSize,Doff
doheadinc
inc Coldex
lda Coldex
cmp Columns
bge endheader
lda #1
jsr FixDptr
jcs error
short
lda #Tab
sta [Dptr]
long
IncLong Doff
AddLong FieldPtr,[FieldPtr],Temp
MoveLong Temp,FieldPtr
brl headloop
endheader
lda #1
jsr FixDptr
jcs error
short
lda #CR
sta [Dptr]
long
brl done
error PushLong Src
_HUnlock
PushLong Dest
_DisposeHandle
bra exit
done PushLong Src
_HUnlock
PushLong Dest
_HUnlock
SpaceLong
PushLong Dest
_GetHandleSize
PullLong Dsize
MoveLong Dsize,Doff
Addwl #8,Dsize
PushLong Dsize
PushLong Dest
jsl D_GrowHandle
sta err
jcs error
AddLong [Dest],Doff,Dptr
PushLong #X_CurHeader
PushLong Dptr
PushLong #8
_BlockMove
exit PushWord X_OldCursor
jsl D_SetCursor
return err
;This adds the value in the accumulator to the size of the handle Dest
;and sets the pointer to the end of the previous handle. This does
;not add the size to the offset, it is up to what calls it to do that.
FixDptr clc
adc Dsize
sta Dsize
bcc x2
inc Dsize+2
x2 SpaceLong
pei Dsize+2
pei Dsize
pei Dest+2
pei Dest
jsl D_GrowLHandle
sta err
PullLong Dptr
bcc noprob
rts
noprob AddLong Dptr,Doff,Dptr
clc
rts
FixDptr2 AddLong Dsize,PLSize,Dsize
brl x2
ENDP
X_ScWPtoPLScrap PROC EXPORT
input Src:l
local Soff:l,Sptr:l,Block1:l,Bptr:l,Block2:l,Pars:w
local Ruler:l,Rptr:l,Offset:l,Offset2:w,RealDptr:l
local ParSize:l,Doff:l,Dptr:l,Dsize:l
output Dest:l
error err
begin
MoveWord >D_CurCursor,X_OldCursor
stz err
PushLong >DefaultFont
PushWord >DefaultColor
PushLong Src
jsl X_SwitchFont
tool _MaxBlock,out=(Dsize:l)
call D_NeedHand,in=(Dsize:l),out=(Dest:l),err=err
jcs exit
Stzl Doff
Stzl Dsize
;Get number of paragraphs in scrap
MoveLong [Src],Sptr
MoveWord [Sptr],Pars
MoveLong #2,Soff
parloop lda Pars
jeq exit
AddLong [Src],Soff,Sptr
MoveLong [Sptr],Block1
;Get size of the paragraph. Check to see if this is last paragraph.
Cmpw #1,Pars
jeq lastpar
;Check for different blocks.
MoveLong [Sptr]:#X_scpBytes,Block2
Cmpl Block1,Block2
jne diffblocks
;The next paragraph is in this block to. How convenient.
MoveWord [Sptr]:#X_scpOffset,Offset
MoveWord [Sptr]:#X_scpOffset+X_scpBytes,Offset2
SubWord Offset2,Offset,ParSize
brl domove
;These two case are the same thing. We have to get the size subtracting the offset
;from the used field in the text block.
lastpar
diffblocks MoveLong [Block1],Bptr
MoveWord [Bptr]:#2,Offset2
MoveWord [Sptr]:#X_scpOffset,Offset
SubWord Offset2,Offset,ParSize
domove stz Offset+2
stz ParSize+2
lda ParSize
jsr FixDptr
jcs mem_err
AddLong [Block1],Offset,s
PushLong Dptr
PushLong ParSize
_BlockMove
;Now we fix the ruler
AddLong [Src],Soff,Sptr
;If it's a pagebreak, we move default justification and spacing into the header
MoveWord [Sptr]:#X_scpAttr,a
beq notpagebreak
MoveWord #0,[Dptr]:#5
bra getnextpar
notpagebreak
MoveLong [Sptr]:#X_scpRulerHand,Ruler
MoveLong [Ruler],Rptr
jsr ExtractRuler
ldy #5
sta [Dptr],y
getnextpar Addwl ParSize,Doff
Addwl #X_scpBytes,Soff
dec Pars
brl parloop
mem_err tool _DisposeHandle,in=(Dest:l)
exit PushWord X_OldCursor
jsl D_SetCursor
return
DefaultFont DC.W 4
DC.B 0
DC.B 9
DefaultColor DC.W 0
ExtractRuler
ldy #X_scr_or_Status
lda [Rptr],y
pha
ldx #0
spaceloop
lsr a
bcs foundspace
inx
bra spaceloop
foundspace
pla
lsr a
lsr a
lsr a
lsr a
ldy #0
justloop lsr a
bcs foundjust
iny
bra justloop
foundjust
phx
tya
xba
ora 1,s
xba
plx
rts
FixDptr clc
adc Dsize
sta Dsize
bcc x2
inc Dsize+2
x2 pei Dsize+2
pei Dsize
pei Dest+2
pei Dest
jsl D_GrowHandle
sta err
bcc noprob
rts
noprob MoveLong [Dest],RealDptr
AddLong RealDptr,Doff,Dptr
clc
rts
ENDP
;*********************************************************************
;
; X_SStoPLScrap
;
;*********************************************************************
X_ScSStoPLScrap PROC EXPORT
;Using X_SSScrapData
;Using X_ClipData
;Using D_CursorData
input src:l
output dest:l
local sptr:l,cptr:l,cellcount:l,ascptr:l,colcount:w,colindex:w
local dsize:l,tmp:l,strptr:l,newsize:l,rowindex:w,newstyle:w
local fmt:w,newcolor:w,mysize:l
error err
begin
MoveWord >D_CurCursor,X_OldCursor
cpzl src
bne GetPtr
moveword #-1,err
brl quit
GetPtr rcall D_Deref,in=(src:ax),out=(sptr:ax)
; initial approximation of the size
tool _MaxBlock,out=(mysize:l)
call D_NeedHand,in=(mysize:l),out=(dest:l),err=(err)
jcs exit
moveword [sptr]:#X_SSScrapcols,colcount
stzl dsize
in [sptr]:#X_SSScrapRows:w,[sptr]:#X_SSScrapcols:w
out cellcount:l
xtool _Multiply
addwl #X_SSScrapCells,sptr
moveword #1,rowindex
sta colindex
CellLoop call D_BeachBall
cpzl cellcount
jeq EndCellLoop
cmpw colindex,#1
bne DidParag
addlong dsize,#ParagSize,newsize
call D_GrowHandle,in=(newsize:l,dest:l),err=(err)
jcs abort
pushlong #ParagHdr
addlong [dest],dsize,s
tool _BlockMove,in=(:l,:l,#ParagSize:l)
movelong newsize,dsize
DidParag cmpw [sptr]:#X_SSScrapCellLoc,rowindex
jne EmptyCell
cmpw [sptr]:#X_SSScrapCellLoc+2,colindex
jne EmptyCell
moveword [sptr]:#X_SSScrapFormat,fmt
CkBold moveword #0,newstyle
lda fmt
and #X_SSCellBold
beq CkUline
moveword #Bold,newstyle
CkUline lda fmt
and #X_SSCellULine
beq CkStyle
lda newstyle
ora #Underline
sta newstyle
CkStyle lda newstyle
beq CkType
jsr ChangeStyle
CkType lda fmt
and #X_SSCellType
xba
div16 a
tax
jmp (TypeTable,x)
TypeTable DC.W TextCell,ValueCell,CalcTextCell,FormulaCell
DC.W LpadCell,RpadCell,EmptyCell,EmptyCell
TextCell stz tmp+2
moveword [sptr]:#X_SSScrapValue,a
and #$00FF
sta tmp
addlong a,dsize,newsize
call D_GrowHandle,in=(newsize:l,dest:l),err=(err)
jcs abort
movelong [dest],ascptr
addlong sptr,#X_SSScrapValue+1,s
addlong ascptr,dsize,s
tool _BlockMove,in=(:l,:l,tmp:l)
movelong newsize,dsize
brl DidCell
CalcTextCell stz tmp+2
moveword [sptr]:#X_SSScrapValueSize,a
and #$00FF
sta tmp
addlong a,dsize,newsize
call D_GrowHandle,in=(newsize:l,dest:l),err=(err)
jcs abort
movelong [dest],ascptr
addlong sptr,#X_SSScrapValue,s
addlong ascptr,dsize,s
tool _BlockMove,in=(:l,:l,tmp:l)
movelong newsize,dsize
brl DidCell
FormulaCell
ValueCell spacelong
spacelong
pushword #256
pushlong [sptr]:#X_SSScrapFormat
addlong #X_SSScrapValue,sptr,s
call X_FormatValue ; in=(:w,:l,:l),out=(:w,:l,:w)
ply
pulllong strptr
pla
tya
beq DidColor
moveword #DarkRed,newcolor
jsr ChangeColor
DidColor lda [strptr]
and #$00FF
stz tmp+2
sta tmp
GotSize addlong a,dsize,newsize
incl strptr
call D_GrowHandle,in=(newsize:l,dest:l),err=(err)
jcs abort
movelong [dest],ascptr
pushlong strptr
addlong ascptr,dsize,s
tool _BlockMove,in=(:l,:l,tmp:l)
movelong newsize,dsize
LPadCell
RPadCell
DidCell moveword [sptr]:#X_SSScrapCellSize,tmp
stz tmp+2
addlong tmp,sptr,sptr
moveword #0,newstyle
jsr ChangeStyle
lda newcolor
beq EmptyCell
moveword #Black,newcolor
jsr ChangeColor
EmptyCell incl dsize
call D_GrowHandle,in=(dsize:l,dest:l),err=(err)
jcs abort
movelong [dest],ascptr
addlong ascptr,dsize,ascptr ; set ascptr to last byte
decl ascptr ;
lda colindex
ina
sta colindex
cmp colcount
ble DoTab
moveword #1,colindex
inc rowindex
lda #CR
bra DoSep
DoTab lda #Tab
DoSep shortm
sta [ascptr]
longm
ContCell
decl cellcount
brl CellLoop
EndCellLoop
exit rcall D_UnLock,in=(src:ax)
tool _GetHandleSize,in=(dest:l),out=(dsize:l)
movelong dsize,tmp
addwl #8,dsize
call D_GrowHandle,in=(dsize:l,dest:l)
addlong [dest],tmp,cptr
tool _BlockMove,in=(#ParagHdr:l,cptr:l,#8:l)
quit call D_SetCursor,in=(X_OldCursor:w)
return
abort tool _DisposeHandle,in=(Dest:l)
brl exit
ParagHdr
Font2 DC.W 4
Style DC.B 0
Size DC.B 9
Color DC.B 0
DC.W 0
EndParagHdr
ParagSize equ EndParagHdr-ParagHdr
BogusCR DC.B CR
StyleChange equ 2
ColorChange equ 4
; Local routines.
ChangeColor addwl #2,dsize
call D_GrowHandle,in=(dsize:l,dest:l),err=(err)
jcs abort
movelong [dest],ascptr
addlong ascptr,dsize,ascptr
subwl #2,ascptr
lda newcolor
xba
ora #ColorChange
sta [ascptr]
rts
ChangeStyle addwl #2,dsize
call D_GrowHandle,in=(dsize:l,dest:l),err=(err)
jcs abort
movelong [dest],ascptr
addlong ascptr,dsize,ascptr
subwl #2,ascptr
lda newstyle
xba
ora #StyleChange
sta [ascptr]
rts
ENDP
X_ScDoAsciitoPLText PROC EXPORT
;Using X_ClipData
;Using D_GlobalData
;Using D_CursorData
input Src:l,FontId:l,Color:w
local ASize:l,SSize:l,Aptr:l,SPtr:l,Adex:w,SDex:w
local Aoff:l,Soff:l
output Dest:l
error err
begin
MoveWord >D_CurCursor,X_OldCursor
stz err
MoveLong FontId,X_DefHeader
MoveByte Color,X_DefHeader+4
SpaceLong
PushLong Src
_GetHandleSize
sta err
PullLong ASize
jcs exit
AddLong ASize,#7,Ssize
SpaceLong
PushLong Ssize
jsl D_NeedHand
sta err
PullLong Dest
jcs abort2
PushLong #X_DefHeader
PushLong Dest
PushLong #7
_PtrToHand
lda Asize
bne notzero
lda Asize+2
jeq exit
notzero MoveLong [Src],Aptr
MoveLong [Dest],Sptr
stz Adex
MoveWord #7,Sdex
stz Aoff
stz Aoff+2
MoveLong #7,Soff
loop jsl D_BeachBall
shortm
ldy Adex
lda [Aptr],y
ldy Sdex
sta [Sptr],y
cmp #CR
longm
jne notcr
AddLong SSize,#7,Ssize
PushLong Ssize
PushLong Dest
jsl D_GrowHandle
sta err
jcs abort
MoveLong [Dest],Sptr
inc Soff
bne yawn
inc Soff+2
yawn AddLong Sptr,Soff,Sptr
PushLong #X_DefHeader
PushLong Sptr
PushLong #7
_BlockMove
AddLong Soff,#6,Soff
MoveWord #6,Sdex
notcr inc Adex
bne notbig
AddLong Aptr,#$10000,Aptr
notbig inc Aoff
bne noroll
inc Aoff+2
noroll inc Sdex
bne notbig2
AddLong Sptr,#$10000,Sptr
notbig2 inc Soff
bne noroll2
inc Soff+2
noroll2 Cmpl Aoff,Asize
jlt loop
exit IncLong Ssize
PushLong Ssize
PushLong Dest
jsl D_GrowHandle
bcs abort
AddLong [Dest],Ssize,Sptr
DecLong Sptr
MoveByte #CR,[Sptr]
abort2 PushWord X_OldCursor
jsl D_SetCursor
return err
abort PushLong dest
_DisposeHandle
bra abort2
ENDP
END
Reference in New Issue View Git Blame Copy Permalink