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 '' 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