mirror of
https://github.com/antoinevignau/source.git
synced 2025-01-22 14:30:24 +00:00
1 line
15 KiB
Plaintext
1 line
15 KiB
Plaintext
|
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
A
|