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

1 line
16 KiB
Plaintext
Executable File

LOAD 'Macros.dump'
INCLUDE 'SS.equ'
INCLUDE 'Driver.equ'
INCLUDE 'Heap.aii.i'
;------------------------------------------
;
; Equates from procedure S_BarData
;
;------------------------------------------
S_CHARTMAXH equ 16
S_BarHeight equ 150
S_BarHZero equ 80
S_BarVZero equ 160
;-----------------------------------------------
;
; Imported addresses
;
;-----------------------------------------------
IMPORT D_ClosePicture
IMPORT D_AlertBox
IMPORT D_CheckPurge
IMPORT D_DrawString
IMPORT D_FastMult
IMPORT D_KillFont
IMPORT D_SelectFont
IMPORT D_Set4Pat
IMPORT X_FormatValue
IMPORT S_ChartTitleLoc
IMPORT S_LinearMax
IMPORT S_LinearMaxVal
IMPORT S_BigBar
IMPORT S_ChartColors
IMPORT S_Cur2Heap
IMPORT S_GetCellPtr
IMPORT S_GetMinMax
IMPORT S_ItzaBar
IMPORT S_NoData
IMPORT S_NormalizeRange
IMPORT S_NoINF
IMPORT S_OneDatum
IMPORT S_PictRect
IMPORT S_PieOffset
IMPORT S_PieSum
IMPORT S_TraverseRange
IMPORT S_decform2
IMPORT S_drec2
;-----------------------------------------------
;
; Forward addresses and entries
;
;-----------------------------------------------
ENTRY S_DoPtPlot
ENTRY S_BarCount
ENTRY S_BarMax
ENTRY S_BarMin
ENTRY S_BarPoly
ENTRY S_BarRect
ENTRY S_BarSpace
ENTRY S_BarWidth
ENTRY S_ChartAxes
ENTRY S_DoPlot
ENTRY S_DoScaling
ENTRY S_OldPt
ENTRY S_Plot3DBar
ENTRY S_PlotAxes
ENTRY S_PlotLine
;---------------------------------------------------------------------------
;
; S_MakeBar
;
;
S_MakeBar PROC EXPORT
;Using S_CurrentData2
;Using S_ChartData
;Using S_BarData
;Using S_PieData
;Using SANEEQUS
input charthdl:l
output pict:l
local color:w,OldClip:l,chart:l
local cellptr:l,col:w,tmp:l
local topl:l,botr:l,type:l
error err
begin
stz err
H_GetBlockPtr charthdl,chart
call S_NormalizeRange,in=([chart]:#S_CRange:l,[chart]:#S_CRange+4:l)
pulllong botr
pulllong topl
cmpw topl+2,botr+2
beq ItsVert
subword botr,topl,a
bra CkMax
ItsVert subword botr,topl,a
CkMax cmp #257
blt OKSize
call D_AlertBox,in=(#OKCancelBox:w,#S_BigBar:l),out=(a:w)
cmp #Cancel
jeq abort
cmpw topl+2,botr+2
beq ItsVert2
addword topl+2,#255,botr+2
bra OKSize
ItsVert2 addword topl,#255,botr
OKSize moveword #1,S_ItzaBar
stz S_PieOffset
call S_TraverseRange,in=(topl:l,botr:l,#S_PieSum:l),err=(err)
jcs quit
lda S_PieOffset
beq NoData
cmp #1
bne OpenIt
stz type+2
moveaddr S_DoPtPlot+1,type ; hack to find out what kind
cmpl type,#S_PlotLine ; of chart is being generated.
bne OpenIt
call D_AlertBox,in=(#1:w,#S_OneDatum:l),out=(a:w)
brl abort
NoData call D_AlertBox,in=(#1:w,#S_NoData:l),out=(a:w)
brl abort
OpenIt call S_GetMinMax,in=(topl:l,botr:l,#1:w),out=(:l)
tool FCLASSX,in=(:l)
txa
asl a
cmp #2*FCINF
beq @INF
call S_GetMinMax,in=(topl:l,botr:l,#0:w),out=(:l)
tool FCLASSX,in=(:l)
txa
asl a
cmp #2*FCINF
bne @dopict
@INF call D_AlertBox,in=(#1:w,#S_NoINF:l),out=(a:w)
brl abort
@dopict
movelong topl,[chart]:#S_CRange
movelong botr,[chart]:#S_CRange+4
tool _NewRgn,out=(OldClip:l),err=(err)
jcs quit
tool _GetClip,in=(OldClip:l)
tool _ClipRect,in=(#S_PictRect:l)
tool _OpenPicture,in=(#S_Pictrect:l),out=(pict:l)
_PenNormal
tool _SetPenSize,in=(#2:w,#1:w)
pushlong topl
pushlong botr
H_GetBlockPtr charthdl,chart
addlong #S_CMin,chart,s
addlong #S_CMax,chart,s
call S_DoScaling,in=(:l,:l,:l,:l,[chart]:#S_CIsMax:w)
H_GetBlockPtr charthdl,chart
call S_ChartAxes,in=(topl:l,botr:l,[chart]:#S_SpaceBar:w)
addword S_BarSpace,#S_BarHZero,S_BarRect+2
stz S_BarCount
moveword #S_BarVZero,S_OldPt
moveword #S_BarHZero,S_OldPt+2
moveword #S_BarVZero,S_LinearMax
call S_TraverseRange,in=(topl:l,botr:l,#S_DoPlot:l)
H_GetBlockPtr charthdl,chart
call S_PlotAxes,in=(topl:l,botr:l,[chart]:#S_SpaceBar:w)
DoTitle tool _MoveTo,in=(S_ChartTitleLoc:l)
_PenNormal ; necess. for #'s in case of 0's ==> no colour
jsl D_KillFont
rcall D_SelectFont,in=(#$FFFE:a,#$0800:x,#0:y)
H_GetBlockPtr charthdl,chart
addlong chart,#S_CName,s
call D_DrawString,in=(:l)
jsl D_ClosePicture
bcs @picErr
call D_CheckPurge
bcc exit
@picErr tool _KillPicture,in=(pict:l)
call D_CheckPurge
dec err
exit _PenNormal
whoops tool _SetClip,in=(OldClip:l)
tool _DisposeRgn,in=(OldClip:l)
quit stz S_ItzaBar
return
abort dec err
bra quit
ENDP
;---------------------------------------------------------------------------
;
; S_ChartAxes
;
S_ChartAxes PROC EXPORT
;Using S_ChartData
;Using S_BarData
input topl:l,botr:l,spacing:w
local range:w,width:w,ptr:l
BEGIN
cmpw topl+2,botr+2
beq Top2Bot
subword botr+2,topl+2,a
inc a
sta range
bra DidRange
Top2Bot subword botr,topl,a
inc a
sta range
DidRange moveword #560,width
cmpw range,#S_CHARTMAXH+1
bge TooBig
rcall D_FastMult,in=(range:x,#32:y)
addword a,#16,width
lda spacing
bne DoSpaces
moveword #32,S_BarWidth
stz S_BarSpace
bra GotWidth
DoSpaces moveword #16,S_BarWidth
moveword #16,S_BarSpace
bra GotWidth
TooBig spacelong
pushword #1120
lda range
asl a
inc a
pha
_UDivide
lda spacing
bne DoSpaces2
pullword S_BarWidth
pla
stz S_BarSpace
bra GotWidth
DoSpaces2 pla
plx
asl a
spacelong
pha
pushword #3
_UDivide
pla
plx
sta S_BarWidth
lsr a
sta S_BarSpace
GotWidth RETURN
ENDP
;---------------------------------------------------------------------------
;
; S_PlotAxes
;
S_PlotAxes PROC EXPORT
;Using S_ChartData
;Using S_BarData
input topl:l,botr:l,spacing:w
local range:w,width:w,ptr:l,tmp:l
local negY:w
BEGIN
subword #S_BarVZero,S_LinearMax,negY
cmpw topl+2,botr+2
beq Top2Bot
subword botr+2,topl+2,a
inc a
sta range
bra DidRange
Top2Bot subword botr,topl,a
inc a
sta range
DidRange moveword #560,width
cmpw range,#S_CHARTMAXH+1
bge TooBig
rcall D_FastMult,in=(range:x,#32:y)
addword a,#16,width
lda spacing
bne DoSpaces
moveword #32,S_BarWidth
stz S_BarSpace
bra GotWidth
DoSpaces moveword #16,S_BarWidth
moveword #16,S_BarSpace
bra GotWidth
TooBig spacelong
pushword #1120
lda range
asl a
inc a
pha
_UDivide
lda spacing
bne DoSpaces2
pullword S_BarWidth
pla
stz S_BarSpace
bra GotWidth
DoSpaces2 pla
plx
asl a
spacelong
pha
pushword #3
_UDivide
pla
plx
sta S_BarWidth
lsr a
sta S_BarSpace
GotWidth _PenNormal
jsl D_KillFont
rcall D_SelectFont,in=(#$FFFE:a,#$0800:x,#0:y)
in #S_BarHZero-6:w,#0:l,#S_BarMin:l
out tmp:w,ptr:l,a:w
xcall X_FormatValue
subword #S_BarHZero-6,tmp,tmp
tool _MoveTo,in=(tmp:w,#S_BarVZero:w)
call D_DrawString,in=(ptr:l)
in #S_BarHZero-6:w,#0:l,#S_BarMax:l
out tmp:w,ptr:l,a:w
xcall X_FormatValue
subword #S_BarHZero-6,tmp,tmp
tool _MoveTo,in=(tmp:w,#S_BarVZero-S_BarHeight:w)
call D_DrawString,in=(ptr:l)
lda negY
bpl @noNegY
in #S_BarHZero-6:w,#0:l,#S_LinearMaxVal:l
out tmp:w,ptr:l,a:w
xcall X_FormatValue
subword #S_BarHZero-6,tmp,tmp
addword S_LinearMax,#10,tmp+2
tool _MoveTo,in=(tmp:w,tmp+2:w)
call D_DrawString,in=(ptr:l)
@noNegY
tool _SetPenSize,in=(#2:w,#1:w)
; Horizontal axis (group both axes)
tool _PicComment,in=(#picLParen:w,#0:w,#0:l)
tool _MoveTo,in=(#S_BarHZero-6:w,#S_BarVZero:w)
tool _Line,in=(width:w,#0:w)
; Vertical axis
tool _MoveTo,in=(#S_BarHZero:w,#S_BarVZero-S_BarHeight:w)
tool _LineTo,in=(#S_BarHZero:w,S_LinearMax:w)
; Stubs
tool _MoveTo,in=(#S_BarHZero:w,#S_BarVZero-S_BarHeight:w)
tool _Line,in=(#-6:w,#0:w)
lda negY
bpl @nothird
tool _MoveTo,in=(#S_BarHZero:w,S_LinearMax:w)
tool _Line,in=(#-6:w,#0:w)
@nothird
tool _PicComment,in=(#picRParen:w,#0:w,#0:l)
RETURN
ENDP
;---------------------------------------------------------------------------
;
; S_DoPlot
;
S_DoPlot PROC EXPORT
;Using S_ChartData
;Using S_CurrentData2
;Using SANEEQUS
;Using S_BarData
EXPORT S_DoPtPlot
input cell:l
local cellptr:l,h1:w,height:r,tmp:l
local h2:w,tmpSane:r
local h3:w,tmpSane2:r
BEGIN +b
addword S_BarRect+2,S_BarWidth,S_BarRect+6
call S_GetCellPtr,in=(cell:l),out=(cellptr:l)
ora CellPtr
jeq exit
addlong cellptr,#S_CellFormat,tmp
lda [tmp]
and #S_CellTypeValue
cmp #S_CellTypeText
jeq exit
addlong cellptr,#S_CellValue,cellptr
tool FCLASSX,in=(cellptr:l)
txa
asl a
cmp #2*FCINF
jeq exit ; is it infinity? skip it.
moveword #S_BarHeight,tmp
tool FI2X,in=(!tmp:l,!height:l)
moveX [cellptr],tmpSane
tool FSUBX,in=(#S_BarMin:l,!tmpSane:l)
moveX S_BarMax,tmpSane2
tool FSUBX,in=(#S_BarMin:l,!tmpSane2:l)
tool FDIVX,in=(!tmpSane2:l,!height:l)
tool FMULX,in=(!tmpSane:l,!height:l)
tool FX2I,in=(!height:l,!tmp:l)
subword #S_BarVZero,tmp,a
bmi PlotIt
cmp S_LinearMax
blt PlotIt
sta S_LinearMax
moveX [cellptr],S_LinearMaxVal
PlotIt stz cell+2
moveaddr S_DoPtPlot+1,cell ; hack to find out what kind
cmpl cell,#S_Plot3DBar ; of chart is being generated.
bne NormPlot ; Only group 3D-bar charts...
tool _PicComment,in=(#picLParen:w,#0:w,#0:l)
jsr HeresPlot
tool _PicComment,in=(#picRParen:w,#0:w,#0:l)
bra exit
NormPlot jsr HeresPlot
bra exit
HeresPlot pushlong tmp
S_DoPtPlot
jsl >0
rts
exit RETURN
ENDP
;---------------------------------------------------------------------------
;
; S_PlotBar
;
S_PlotBar PROC EXPORT
;Using S_ChartData
;Using S_CurrentData2
;Using SANEEQUS
;Using S_BarData
input pt:l
BEGIN
lda pt
bmi NegVal
subword #S_BarVZero,pt,S_BarRect
moveword #S_BarVZero+1,S_BarRect+4
bra GotRect
NegVal subword #S_BarVZero,pt,S_BarRect+4
moveword #S_BarVZero,S_BarRect
GotRect movelong #S_ChartColors,pt
lda S_BarCount
cmp #$0C
blt DoColor
lda #0
sta S_BarCount
DoColor asl a
tay
call D_Set4Pat,in=([pt]:y:w)
inc S_BarRect+6
inc S_BarRect+6
tool _PaintRect,in=(#S_BarRect:l)
_PenNormal
tool _SetPenSize,in=(#2:w,#1:w)
tool _FrameRect,in=(#S_BarRect:l)
dec S_BarRect+6
dec S_BarRect+6
exit addword S_BarRect+6,S_BarSpace,S_BarRect+2
inc S_BarCount
RETURN
ENDP
;---------------------------------------------------------------------------
;
; S_Plot3DBar
;
S_Plot3DBar PROC EXPORT
;Using S_ChartData
;Using S_CurrentData2
;Using SANEEQUS
;Using S_BarData
input pt:l
local pt1:l,pt2:l,pt3:l,pt4:l,pt5:l
BEGIN
lda pt
bmi NegVal
subword #S_BarVZero,pt,S_BarRect
moveword #S_BarVZero+1,S_BarRect+4
bra GotRect
NegVal subword #S_BarVZero,pt,S_BarRect+4
moveword #S_BarVZero,S_BarRect
GotRect movelong #S_ChartColors,pt
lda S_BarCount
cmp #$0C
blt DoColor
lda #0
sta S_BarCount
DoColor asl a
tay
call D_Set4Pat,in=([pt]:y:w)
inc S_BarRect+6
inc S_BarRect+6
tool _PaintRect,in=(#S_BarRect:l)
_PenNormal
tool _SetPenSize,in=(#2:w,#1:w)
tool _FrameRect,in=(#S_BarRect:l)
subword S_BarRect,#4,pt1
addword S_BarRect+2,#8,pt1+2
moveword pt1,pt2
addword S_BarRect+6,#6,pt2+2
moveword pt2+2,pt3+2
subword S_BarRect+4,#5,pt3
movelong S_BarRect+4,pt4
dec pt4
dec pt4+2
dec pt4+2
moveword S_BarRect,pt5
subword S_BarRect+6,#2,pt5+2
tool _OpenPoly,out=(S_BarPoly:l)
tool _MoveTo,in=(pt4:l)
tool _LineTo,in=(pt5:l)
tool _LineTo,in=(pt2:l)
tool _LineTo,in=(pt3:l)
tool _LineTo,in=(pt4:l)
_ClosePoly
tool _PicComment,in=(#picLParen:w,#0:w,#0:l)
call D_Set4Pat,in=(#RightGray:w)
tool _PaintPoly,in=(S_BarPoly:l)
call D_Set4Pat,in=(#Black:w)
; tool _FramePoly,in=(S_BarPoly:l) ;
tool _MoveTo,in=(pt4:l) ;
tool _LineTo,in=(pt5:l) ; Work around Apple's
tool _LineTo,in=(pt2:l) ; polygon - picture bug
tool _LineTo,in=(pt3:l) ;
tool _LineTo,in=(pt4:l) ;
tool _KillPoly,in=(S_BarPoly:l)
tool _PicComment,in=(#picRParen:w,#0:w,#0:l)
tool _OpenPoly,out=(S_BarPoly:l)
tool _MoveTo,in=(S_BarRect:l)
tool _LineTo,in=(pt5:l)
tool _LineTo,in=(pt2:l)
tool _LineTo,in=(pt1:l)
tool _LineTo,in=(S_BarRect:l)
_ClosePoly
tool _PicComment,in=(#picLParen:w,#0:w,#0:l)
tool _PaintPoly,in=(S_BarPoly:l)
; tool _FramePoly,in=(S_BarPoly:l) ;
tool _MoveTo,in=(S_BarRect:l) ; As above...
tool _LineTo,in=(pt5:l) ;
tool _LineTo,in=(pt2:l) ;
tool _LineTo,in=(pt1:l) ;
tool _LineTo,in=(S_BarRect:l) ;
tool _KillPoly,in=(S_BarPoly:l)
tool _PicComment,in=(#picRParen:w,#0:w,#0:l)
dec S_BarRect+6
dec S_BarRect+6
addword S_BarRect+6,S_BarSpace,S_BarRect+2
inc S_BarCount
RETURN
ENDP
;---------------------------------------------------------------------------
;
; S_DoScaling
;
S_DoScaling PROC EXPORT
;Using S_BarData
;Using SANEEQUS
;Using S_SaneData2
input first:l,last:l,min:l,max:l,isMax:w
local h1:w,sanetmp:r,tmpmin:l
BEGIN
moveX [min],S_BarMin
lda isMax
jne DoMove
; Find the absolute Max over range
call S_GetMinMax,in=(first:l,last:l,#0:w),out=(tmpmin:l)
moveX [tmpmin],sanetmp
movelong !sanetmp,tmpmin
call S_GetMinMax,in=(first:l,last:l,#1:w),out=(max:l)
moveX [tmpmin],sanetmp
tool FABSX,in=(!sanetmp:l)
tool FCMPX,in=(!sanetmp:l,max:l)
bvc @didAbs
movelong !sanetmp,max
@didAbs
stz S_decform2 ; float
moveword #3,S_decform2+2 ; 3 digits
DidDecPlace tool FX2DEC,in=(#S_decform2:l,max:l,#S_drec2:l)
lda S_drec2
bne AllNeg
DoCeiling moveword #$3030,S_drec2+6 ; '00'
lda S_drec2+5
and #$FF
ina
cmp #'9'+1
blt GotNew
inc S_drec2+2
lda #'1'
bra GotNew
AllNeg call S_GetMinMax,in=(first:l,last:l,#0:w),out=(max:l)
tool FX2DEC,in=(#S_decform2:l,max:l,#S_drec2:l)
stz S_drec2
bra DoCeiling
GotNew xba
ora #3 ; strlen.
sta S_drec2+4
tool FDEC2X,in=(#S_drec2:l,#S_BarMax:l)
tool FTESTXCP,in=(#$0004:w) ; Ck for overflow
beq exit
DoMove moveX [max],S_BarMax
exit RETURN
ENDP
;---------------------------------------------------------------------------
;
; S_PlotLine
;
S_PlotLine PROC EXPORT
;Using S_ChartData
;Using S_CurrentData2
;Using SANEEQUS
;Using S_BarData
input pt:l
BEGIN
moveword S_BarRect+2,pt+2
subword #S_BarVZero,pt,pt
lda S_BarCount
ina
sta S_BarCount
cmp #1
beq exit
tool _MoveTo,in=(S_OldPt:l)
tool _LineTo,in=(pt:l)
exit movelong pt,S_OldPt
addword S_BarRect+6,S_BarSpace,S_BarRect+2
RETURN
ENDP
;---------------------------------------------------------------------------
;
; S_PlotPt
;
S_PlotPt PROC EXPORT
;Using S_ChartData
;Using S_CurrentData2
;Using SANEEQUS
;Using S_BarData
input pt:l
local dotrect:r
BEGIN
moveword S_BarRect+2,pt+2
subword #S_BarVZero,pt,pt
movelong pt,dotrect
movelong pt,dotrect+4
dec dotrect
inc dotrect+4
inc dotrect+4
dec dotrect+2
dec dotrect+2
inc dotrect+6
inc dotrect+6
inc dotrect+6
tool _PaintOval,in=(!dotrect:l)
movelong pt,S_OldPt
exit addword S_BarRect+6,S_BarSpace,S_BarRect+2
RETURN
ENDP
;---------------------------------------------------------------------------
;
; S_BarData
;
S_BarData PROC EXPORT
EXPORT S_OldPt
EXPORT S_BarCount
EXPORT S_BarWidth
EXPORT S_BarSpace
EXPORT S_BarMax
EXPORT S_BarMin
EXPORT S_BarRect
EXPORT S_BarPoly
S_OldPt DS.L 1
S_BarCount DS.W 1
S_BarWidth DS.W 1
S_BarSpace DS.W 1
S_BarMax DS.B 10
S_BarMin DC.W 0,0,0,0,0
S_BarRect DS.B 8
S_BarPoly DS.L 1
ENDP
END