Code: Select all
XIncludeFile "MINIBGI.pbi"
DeclareModule MINIPLOT
EnableExplicit
#MAXINTEGER = 65535
; sets clipping of plotting on: i.e. only within actual plot region
; delimited by XMin->XMax And YMin->YMax
Declare SetClipOn()
; sets clipping of plotting off: i.e. can plot anywhere on the screen,
; but window is still delimited by XMin->XMax And YMin->YMax
Declare SetClipOff()
; clears a status line at the very top of the screen;
; you have To be in graphics mode For this To work.
Declare Clear_StatusLine()
; writes out a status line "Message" after clearing the status line
; you have To be in graphics mode For this To work.
Declare Write_StatusLine(Message.s)
; defines constants (XAxisScale,YAxisScale,ConstX,ConstY) which are used
; To convert To And from world And window coordinate systems.
Declare Setscale(WXMin.d,WXMax.d,WYMin.d,WYMax.d)
;performs transformation from world coordinates to window (screen) coordinates
Declare World_to_Window(x.d,y.d, *XScreen.integer, *YScreen.integer)
; performs transformation from window (screen) coordinates To world
; coordinates
Declare Window_to_World(XScreen.i,YScreen.i, *x.double, *y.double)
; move graphics cursor To world coordinate X,Y
Declare Move(X.d,Y.d)
; draw line from present position of graphics cursor To world
; coordinate X,Y; use BGI Declare SetLineStyle to change from
; solid To dotted, dashed, etc
Declare Draw(X.d,Y.d)
; move graphics cursor a relative distance (in world coordinates) from
; present position
Declare RelMove(X.d,Y.d)
; draw line from present position of graphics cursor To a new
; position given by the relative distance X,Y (in world coordinates)
; use BGI Declare SetLineStyle To change from solid To dotted,
; dashed, etc
Declare RelDraw(X.d,Y.d)
; Draws tick marks For "axes" And "frame" With minor tick intervals
; every XTick,YTick, And major ticks every XMajor,YMajor minor ticks.
; Tick_Proc checks If x And y axes are running the conventional directions
; (i.e. xmin->max is left To right And ymin->ymax is up) And acts accordingly;
; This routine is only used internally by HiGraf.
;Declare Tick_Proc(Xarg.d,Yarg.d,XTick.d,YTick.d, XMajor.i,YMajor.i, GridOn.b)
Declare Tick_Proc(Xarg.d, Yarg.d, XTick.d, YTick.d, XMajor.i, YMajor.i, GridOn.i)
; draws a frame around box determined by XMin,XMax And YMin,YMax;
; put minor ticks every XTick,YTick interval With major ticks every
; XMajor,YMajor multiples of XTick,YTick; if GridOn = TRUE a grid
; is drawn
Declare Frame(XTick.d,YTick.d, XMajor.i,YMajor.i, GridOn.b)
; puts STRING Labl at the top of the plot
Declare TopTitle(Labl.s)
; labels x axis With STRING Labl; Label_Axes sets up variable MaxLabHeight
; which is used For XAxisTitle offset; if you haven't called Label_Axes,
; Setup_Graph has initialized MaxLabHeight To 0;
Declare XAxisTitle(Labl.s)
; labels y axis With STRING Labl; Label_Axes sets up variable MaxLabLength
; which is used For YAxisTitle offset; if you haven't called Label_Axes,
; Setup_Graph has initialized MaxLabLength To 0;
Declare YAxisTitle(Labl.s)
; This Declare draws a label at position X,Y in world coordinates;
; the variables "Font,Direction,Size,XJust,YJust" are just As in the
; BGI description For Turbo Pascal graphics:
; Font,Direction, And Size are set by a BGI proc "SetTextStyle" And
; XJust,YJust are set by a BGI proc "SetTextJustify"
Declare Draw_Label(X.d,Y.d, Strng.s,Font.i,Direction.i,Size.i, XJust.i,YJust.i)
; Draws a pair of axes through XOrg,YOrg With minor tick intervals
; XTick,YTick, And major ticks every XMajor,YMajor minor tick
; intervals; if the flag GridOn = TRUE then a grid is drawn
Declare Axes(XOrg.d,YOrg.d,XTick.d,YTick.d, XMajor.i,YMajor.i, GridOn.b)
; Labels axes at intervals LabelX, LabelY; by convention you may
; want this To be :
; LabelX = XMajor*XTick
; LabelY = YMajor*YTick
; in your program
Declare Label_Axes(LabelX.d,LabelY.d)
; Plots a Symbol, scaled by SymSize, centered at world coordinates
; X,Y; available Symbols are:
; 1 - plus
; 2 - box
; 3 - cross (x-like)
; 4 - triangle
; 5 - inverted triangle
; 6 - open circle
; 7 - filled circle
; 8 - dot
Declare PlotPoint(X.d,Y.d, Symbol.i, SymSize.i, color.i)
; Declare To set up the graph limits.
; The world coordinate limits are XMin, XMax, YMin, And YMax.
; The window limits are WXMin, WXMax, WYMin, WYMax expressed As
; fractions (of 1,i.e. 0.95 etc) of the maximum screen limits.
Declare Setup_Graph(XMin.d,XMax.d,YMin.d,YMax.d, WXMin.d,WXMax.d,WYMin.d,WYMax.d,logx.b,logy.b)
; Plots a Symbol, scaled by SymSize, centered at world coordinates
; X,Y; error bar on X,Y are sigx and sigy; available Symbols are:
; 1 - plus
; 2 - box
; 3 - cross (x-like)
; 4 - triangle
; 5 - inverted triangle
; 6 - open circle
; 7 - filled circle
; 8 - dot
Declare PlotData(x.d,sigx.d,y,sigy.d, Symbol.i, SymSize.i, color.i)
EndDeclareModule
Module MINIPLOT
EnableExplicit
UseModule MINIBGI
Global.l Dim Custom_LineStyle(5)
Global.d XWorldMin, XWorldMax,YWorldMin, YWorldMax ; global variables for world limits
Global.i XWindMin, XWindMax, YWindMin, YWindMax ; global variables for window limits
Global.i XViewMax,YViewMax ; viewport limits
Global.d XAxisScale, YAxisScale ; factors for converting
Global.i ConstX, ConstY ; to screen coordinates
Global.b XAxisLog, YAxisLog ; global variables for axis type
Global.i MaxLabLength ; y axis label length in pixels; used To calculate y axis title offset
Global.i MaxLabHeight ; x axis label height in pixels; used To calculate x axis title offset
Global.i MaxColor ; store GetMaxColor value
; sets clipping of plotting on: i.e. only within actual plot region
; delimited by XMin->XMax And YMin->YMax
Procedure SetClipOn()
SetViewPort(XWindMin,YWindMin,XWindMax,YWindMax,#ClipOn)
EndProcedure
; sets clipping of plotting off: i.e. can plot anywhere on the screen,
; but window is still delimited by XMin->XMax And YMin->YMax
Procedure SetClipOff()
SetViewPort(XWindMin,YWindMin,XWindMax,YWindMax,#ClipOff)
EndProcedure
; clears a status line at the very top of the screen;
; you have To be in graphics mode For this To work.
Procedure Clear_StatusLine()
Protected.i Status_Width = 12 ; is status line 12 pixels tall?
SetViewPort(0,0,GetMaxX(),GetMaxY(),#ClipOff)
SetFillStyle(#EmptyFill,GetMaxColor())
Bar(0,0,GetMaxX(),Status_Width)
SetClipOn()
EndProcedure
; writes out a status line "Message" after clearing the status line
; you have To be in graphics mode For this To work.
Procedure Write_StatusLine(Message.s)
Clear_StatusLine()
SetViewPort(0,0,GetMaxX(),GetMaxY(),#ClipOff)
SetTextStyle(#ArialFont,#HorizDir,6)
SetTextJustify(#LeftText,#TopText)
MoveTo(0,0)
OutText(Message)
SetClipOn()
MoveTo(1,2)
EndProcedure
; defines constants (XAxisScale,YAxisScale,ConstX,ConstY) which are used
; To convert To And from world And window coordinate systems.
Procedure Setscale(WXMin.d,WXMax.d,WYMin.d,WYMax.d)
XWindMin = Round(WXMin*GetMaxX()/100.0, #PB_Round_Down)
XWindMax = Round(WXMax*GetMaxX()/100.0, #PB_Round_Down)
YWindMin = Round(WYMin*GetMaxY()/100.0, #PB_Round_Down)
YWindMax = Round(WYMax*GetMaxY()/100.0, #PB_Round_Down)
XViewMax = XWindMax-XWindMin
YViewMax = YWindMax-YWindMin
If XAxisLog
XAxisScale = XViewMax /(Log10(XWorldMax)-Log10(XWorldMin))
ConstX = -Round(Log10(XWorldMin)*XAxisScale, #PB_Round_Down)
Else
XAxisScale = XViewMax/(XWorldMax-XWorldMin)
ConstX = -Round(XWorldMin*XAxisScale, #PB_Round_Down)
EndIf
If YAxisLog
YAxisScale = YViewMax/(Log10(YWorldMin)-Log10(YWorldMax))
ConstY = -Round(Log10(YWorldMax)*YAxisScale, #PB_Round_Down)
Else
YAxisScale = YViewMax/(YWorldMin-YWorldMax)
ConstY = -Round(YWorldMax*YAxisScale, #PB_Round_Down)
EndIf
EndProcedure
;performs transformation from world coordinates to window (screen) coordinates
Procedure World_to_Window(x.d,y.d, *XScreen.integer, *YScreen.integer)
Protected.d temp
Protected.i isign
If XAxisLog
If (x > 0.0)
x = Log10(x)
Else
x = Log10(XWorldMin)
EndIf
EndIf
If YAxisLog
If (y > 0.0)
y = Log10(y)
Else
y = Log10(YWorldMin)
EndIf
EndIf
temp = x * XAxisScale + ConstX
isign = Sign(temp)
If isign*temp < #MAXINTEGER
*XScreen\i = Round(temp, #PB_Round_Down)
Else
*XScreen\i = isign*#MAXINTEGER
EndIf
temp = y * YAxisScale + ConstY
isign = Sign(temp)
If isign*temp < #MAXINTEGER
*YScreen\i = Round(temp, #PB_Round_Down)
Else
*YScreen\i = isign*#MAXINTEGER
EndIf
EndProcedure
; performs transformation from window (screen) coordinates To world
; coordinates
Procedure Window_to_World(XScreen.i,YScreen.i, *x.double, *y.double)
*x\d = (1.0*XScreen-ConstX)/XAxisScale
*y\d = (1.0*YScreen-ConstY)/YAxisScale
If XAxisLog
*x\d = Pow(10.0,*x\d)
EndIf
If YAxisLog
*y\d = Pow(10.0,*y\d)
EndIf
EndProcedure
; move graphics cursor To world coordinate X,Y
Procedure Move(X.d,Y.d)
Protected xs.i,ys.i
World_to_Window(X,Y,@xs,@ys)
MoveTo(xs,ys)
EndProcedure
; draw line from present position of graphics cursor To world
; coordinate X,Y; use BGI procedure SetLineStyle to change from
; solid To dotted, dashed, etc
Procedure Draw(X.d,Y.d)
Protected xs.i,ys.i
World_to_Window(X,Y,@xs,@ys)
LineTo(xs,ys)
EndProcedure
; move graphics cursor a relative distance (in world coordinates) from
; present position
Procedure RelMove(X.d,Y.d)
Protected xs.i,ys.i
World_to_Window(X,Y,@xs,@ys)
MoveRel(xs,ys)
EndProcedure
; draw line from present position of graphics cursor To a new
; position given by the relative distance X,Y (in world coordinates)
; use BGI Procedure SetLineStyle To change from solid To dotted,
; dashed, etc
Procedure RelDraw(X.d,Y.d)
Protected xs.i,ys.i
World_to_Window(X,Y,@xs,@ys)
LineRel(xs,ys)
EndProcedure
; Draws tick marks For "axes" And "frame" With minor tick intervals
; every XTick,YTick, And major ticks every XMajor,YMajor minor ticks.
; Tick_Proc checks If x And y axes are running the conventional directions
; (i.e. xmin->max is left To right And ymin->ymax is up) And acts accordingly;
; This routine is only used internally by HiGraf.
Procedure Tick_Proc(Xarg.d,Yarg.d,XTick.d,YTick.d, XMajor.i,YMajor.i, GridOn.i)
Protected.d XTick_scale = 0.015 ; scale factors for tick lengths
Protected.d YTick_scale = 0.005
Protected.d x, y, decade, tempmin, tempmax
Protected.i ticklen, i
; draw x axis tick marks
ticklen = Round(XTick_scale*GetMaxY(), #PB_Round_Down)
If XWorldMin <= XWorldMax ; normal axis direction
tempmin = XWorldMin
tempmax = XWorldMax
Else ; axis is reversed from normal
tempmin = XWorldMax
tempmax = XWorldMin
EndIf
If XAxisLog ; x axis is logarithmic
decade = Pow(10.0,Log(tempmin)) ; get next lower decade
While (decade <= tempmax)
Move(decade, Yarg)
LineRel(0, 2 * ticklen)
LineRel(0, -4 * ticklen)
If GridOn
Move(decade, YWorldMin)
Draw(decade, YWorldMax)
EndIf
For i = 3 To 9
x = decade * i
If GridOn = #True
SetLineStyle(#DottedLn, 0, 1) ; fine dotted line
Move(x, YWorldMin)
Draw(x, YWorldMax)
SetLineStyle(#SolidLn,0,#NormWidth)
EndIf
If x <= tempmax
Move(x,Yarg)
LineRel(0, ticklen)
LineRel(0, -2 * ticklen)
EndIf
Next
decade = decade * 10.0
Wend
ElseIf XTick > 0.0 ; x axis is linear
x = tempmin+XTick
i = 1
Repeat
Move(x,Yarg)
If (i % XMajor) = 0
LineRel(0,2*ticklen)
LineRel(0,-4*ticklen)
Else
LineRel(0,ticklen)
LineRel(0,-2*ticklen)
EndIf
If GridOn = #True
If (i % XMajor) <> 0
SetLineStyle(#DottedLn,0,1)
EndIf ; fine dotted line
Move(x,YWorldMin)
Draw(x,YWorldMax)
SetLineStyle(#SolidLn,0,#NormWidth)
EndIf
INC(x, XTick)
INC(i)
Until (x > tempmax)
EndIf ; ELSE IF (XTick...
; draw y axis tick marks
ticklen = Round(YTick_scale*GetMaxX(), #PB_Round_Down)
If YWorldMin <= YWorldMax ; normal axis direction
tempmin = YWorldMin
tempmax = YWorldMax
Else ; axis is reversed from normal
tempmin = YWorldMax
tempmax = YWorldMin
EndIf
If YAxisLog ; y axis is logarithmic
decade = Pow(10.0,Log(tempmin)) ; get next lowest decade
While (decade <= tempmax)
Move(Xarg,decade)
LineRel(-2*ticklen,0)
LineRel(4*ticklen,0)
If GridOn
Move(XWorldMin,decade)
Draw(XWorldMax,decade)
EndIf
For i = 3 To 9
y = decade*i
If y <= tempmax
Move(Xarg,y)
LineRel(-ticklen,0)
LineRel(2*ticklen,0)
EndIf
If GridOn = #True
SetLineStyle(#DottedLn,0,1) ; fine dotted line
Move(XWorldMin,y)
Draw(XWorldMax,y)
SetLineStyle(#SolidLn,0,#NormWidth)
EndIf
Next
decade = decade*10.0
Wend
ElseIf YTick > 0.0 ; y axis is linear
y = tempmin+YTick
i = 1
Repeat
Move(Xarg,y)
If (i % YMajor) = 0
LineRel(-2*ticklen,0)
LineRel(4*ticklen,0)
Else
LineRel(-ticklen,0)
LineRel(2*ticklen,0)
EndIf
If GridOn = #True
If (i % YMajor) <> 0
SetLineStyle(#DottedLn,0,1)
Else
EndIf ; fine dotted line
Move(XWorldMin,y)
Draw(XWorldMax,y)
SetLineStyle(#SolidLn,0,#NormWidth)
EndIf
INC(y,YTick)
INC(i)
Until y > tempmax
EndIf
EndProcedure
; draws a frame around box determined by XMin,XMax And YMin,YMax;
; put minor ticks every XTick,YTick interval With major ticks every
; XMajor,YMajor multiples of XTick,YTick; if GridOn = TRUE a grid
; is drawn
Procedure Frame(XTick.d,YTick.d, XMajor.i,YMajor.i, GridOn.b)
SetClipOff()
; draw frame around world
Move(XWorldMin,YWorldMin)
Draw(XWorldMax,YWorldMin)
Draw(XWorldMax,YWorldMax)
Draw(XWorldMin,YWorldMax)
Draw(XWorldMin,YWorldMin)
SetClipOn()
; add tick marks
Tick_Proc(XWorldMin,YWorldMin,XTick,YTick,XMajor,YMajor,GridOn)
Tick_Proc(XWorldMax,YWorldMax,XTick,YTick,XMajor,YMajor,GridOn)
EndProcedure
Procedure.s Remove_Zeros(Strng.s)
Protected.i i,j,z
Protected.s tmp1,tmp2
Protected.s signs
Strng = Trim(Strng)
i = Len(Strng)
If (Mid(Strng,i-3,i) = "E+0") Or (Mid(Strng,i-3,i) = "E-0")
Strng = Mid(Strng,0,i-4)
i = Len(Strng)
ElseIf (Mid(Strng,i-4,i) = "E+00") Or (Mid(Strng,i-4,i) = "E-00")
Strng = Mid(Strng,0,i-5)
i = Len(Strng)
ElseIf (Mid(Strng,i-5,i) = "E+000") Or (Mid(Strng,i-5,i) = "E-000")
Strng = Mid(Strng,0,i-6)
i = Len(Strng)
ElseIf (Mid(Strng,i-6,i) = "E+0000") Or (Mid(Strng,i-6,i) = "E-0000")
Strng = Mid(Strng,0,i-7)
i = Len(Strng)
EndIf
z = FindString(Strng, "E", 1, #PB_String_NoCase)
If z > 0
tmp1 = Mid(Strng,0,z-1)
If Mid(Strng,z+1,1) = "+"
signs = "E+"
tmp2 = Mid(Strng,z+2,i)
ElseIf Mid(Strng,z+1,1) = "-"
signs = "E-"
tmp2 = Mid(Strng,z+2,i)
Else
tmp2 = Mid(Strng,z+1,i)
EndIf
i = Len(tmp1)
If i > 0
While i > 0
If (Mid(tmp1,i-1,1) = " ") Or (Mid(tmp1,i-1,1) = "0")
;tmp1[i-1] = Chr(0)
tmp1 = Mid(tmp1,0,i)
DEC(i)
Else
Break
EndIf
Wend
EndIf
i = Len(tmp1)
If Mid(tmp1,i-1,1) = "."
tmp1 = Mid(tmp1,0,i-2)
EndIf
; start exponent
i = -1
j = Len(tmp2)
If j > 0
While i < j
If (Mid(tmp2,i+1,1) = " ") Or (Mid(tmp2,i+1,1) = "0")
INC(i)
Else
Break
EndIf
Wend
EndIf
If i >= 0
tmp2 = Mid(tmp2,i+1,j)
EndIf
tmp1 = tmp1 + signs
tmp1 = tmp1 + tmp2
Strng = tmp1;
Else ; regular number such as 20.0000
z = FindString(Strng, ".", 1, #PB_String_NoCase)
If z > 0
i = Len(Strng)
If i > 0
While i > 0
If (Mid(Strng,i,1) = " ") Or (Mid(Strng,i,1) = "0")
Strng = Mid(Strng,0,i-1)
DEC(i)
Else
Break
EndIf
Wend
EndIf
i = Len(Strng)
If z > 0
;check for numbers such as -0.302
tmp1 = Mid(Strng,1,z-1) ;-0
tmp2 = Mid(Strng,z+1,i) ; 302
i = Len(tmp1)
While i > 0
If (Mid(tmp1,i,1) = " ") Or (Mid(tmp1,i,1) = "0")
tmp1 = Mid(tmp1, 0, i-1)
DEC(i)
Else
Break
EndIf
Wend
i = Len(tmp2)
While i > 0
If (Mid(tmp2,i,1) = " ") Or (Mid(tmp2,i,1) = "0")
tmp2 = Mid(tmp2,0,i-1)
DEC(i)
Else
Break
EndIf
Wend
If tmp2 <> ""
Strng = tmp1 + "." + tmp2
Else
Strng = tmp1
EndIf
If Strng = ""
Strng = "0"
EndIf
EndIf
EndIf
EndIf
ProcedureReturn Strng
EndProcedure
; puts STRING Labl at the top of the plot
Procedure TopTitle(Labl.s)
Protected.i scale = 24
Protected.i xw,yw
SetClipOff()
xw = Int(XViewMax / 2) - (Len(Labl)/2)
yw = -scale
SetTextStyle(#CourierNewFont,#HorizDir, 16)
SetTextJustify(#CenterText,#BottomText)
OutTextXY(xw, yw, Labl)
SetClipOn()
EndProcedure
; labels x axis With STRING Labl; Label_Axes sets up variable MaxLabHeight
; which is used For XAxisTitle offset; if you haven't called Label_Axes,
; Setup_Graph has initialized MaxLabHeight To 0;
Procedure XAxisTitle(Labl.s)
Protected.i scale = 12
Protected.i xw,yw
SetClipOff()
xw = Int(XViewMax / 2)
yw = YViewMax+MaxLabHeight+scale+16;
SetTextStyle(#CourierNewFont,#HorizDir,16)
SetTextJustify(#CenterText,#TopText)
OutTextXY(xw,yw,Labl)
SetClipOn()
EndProcedure
; labels y axis With STRING Labl; Label_Axes sets up variable MaxLabLength
; which is used For YAxisTitle offset; if you haven't called Label_Axes,
; Setup_Graph has initialized MaxLabLength To 0;
Procedure YAxisTitle(Labl.s)
Protected.i scale = 40
Protected.i xw,yw
SetClipOff()
xw = -MaxLabLength-scale ; adjust position for length of y axis number labels
yw = Int(YViewMax / 2)
SetTextStyle(#CourierNewFont, #VertDir, 16)
SetTextJustify(#RightText, #CenterText)
OutTextXY(xw,yw,Labl)
SetClipOn()
EndProcedure
; This Procedure draws a label at position X,Y in world coordinates;
; the variables "Font,Direction,Size,XJust,YJust" are just As in the
; BGI description For Turbo Pascal graphics:
; Font,Direction, And Size are set by a BGI proc "SetTextStyle" And
; XJust,YJust are set by a BGI proc "SetTextJustify"
Procedure Draw_Label(X.d,Y.d, Strng.s,Font.i,Direction.i,Size.i, XJust.i,YJust.i)
Protected.i xw,yw
SetTextJustify(XJust,YJust)
SetTextStyle(Font,Direction,Size)
World_to_Window(X,Y,@xw,@yw)
OutTextXY(xw,yw,Strng)
EndProcedure
; Draws a pair of axes through XOrg,YOrg With minor tick intervals
; XTick,YTick, And major ticks every XMajor,YMajor minor tick
; intervals; if the flag GridOn = TRUE then a grid is drawn
Procedure Axes(XOrg.d,YOrg.d,XTick.d,YTick.d, XMajor.i,YMajor.i, GridOn.b)
SetClipOn()
Move(XOrg,YWorldMin)
Draw(XOrg,YWorldMax) ; x axis
Move(XWorldMin,YOrg)
Draw(XWorldMax,YOrg) ; y axis
Tick_Proc(XOrg,YOrg,XTick,YTick,XMajor,YMajor,GridOn) ; draw tick marks
EndProcedure
; Labels axes at intervals LabelX, LabelY; by convention you may
; want this To be :
; LabelX = XMajor*XTick
; LabelY = YMajor*YTick
; in your program
Procedure Label_Axes(LabelX.d,LabelY.d)
Protected.i x_location = 8 ; factors for positioning labels
Protected.i y_location = 8
Protected.i xloc,yloc,templength,tempheight
Protected.d tempminx,tempmaxx,tempminy,tempmaxy
Protected.d x,y
Protected.s labl
SetClipOff()
SetTextStyle(#TimesNewRomanFont,#HorizDir,2)
If XWorldMin <= XWorldMax ; regular axis direction
If XAxisLog
; adjust limits to ensure end labels are shown
World_to_Window(XWorldMin,YWorldMin,@xloc,@yloc)
Window_to_World(xloc-1,yloc,@tempminx,@y)
World_to_Window(XWorldMax,YWorldMin,@xloc,@yloc)
Window_to_World(xloc+1,yloc,@tempmaxx,@y)
Else ; X axis is linear
tempminx = XWorldMin
tempmaxx = XWorldMax
EndIf
Else ; reversed axis direction
If XAxisLog
; adjust limits to ensure end labels are shown
World_to_Window(XWorldMax,YWorldMin,@xloc,@yloc)
Window_to_World(xloc+1,yloc,@tempminx,@y)
World_to_Window(XWorldMin,YWorldMin,@xloc,@yloc)
Window_to_World(xloc-1,yloc,@tempmaxx,@y)
Else ; X axis is linear
tempminx = XWorldMax
tempmaxx = XWorldMin
EndIf
EndIf
If YWorldMin <= YWorldMax ; regular axis direction
If YAxisLog
; adjust limits to ensure end labels are shown
World_to_Window(XWorldMin,YWorldMin,@xloc,@yloc)
Window_to_World(xloc,yloc+1,@x,@tempminy)
World_to_Window(XWorldMin,YWorldMax,@xloc,@yloc)
Window_to_World(xloc,yloc-1,@x,@tempmaxy)
Else ; Y axis is linear
tempminy = YWorldMin
tempmaxy = YWorldMax
EndIf
Else ; reversed axis direction
If YAxisLog
; adjust limits to ensure end labels are shown
World_to_Window(XWorldMin,YWorldMax,@xloc,@yloc)
Window_to_World(xloc,yloc-1,@x,@tempminy)
World_to_Window(XWorldMin,YWorldMin,@xloc,@yloc)
Window_to_World(xloc,yloc+1,@x,@tempmaxy)
Else ; Y axis is linear
tempminy = YWorldMax
tempmaxy = YWorldMin
EndIf
EndIf
; label x axis
MaxLabHeight = 0; ; initialize this offset for XAxisTitle
tempheight = 0;
SetTextJustify(#CenterText, #TopText) ; do this just once for linear axis
x = tempminx
If XAxisLog
x = Pow(10.0,Log10(tempminx))
EndIf
While x <= tempmaxx
If XAxisLog
labl = StrD(Log10(x), 3) ; was 6
Else
labl = StrD(x, 3) ; was 5
EndIf
labl = Remove_Zeros(labl)
World_to_Window(x,YWorldMin,@xloc,@yloc)
If XAxisLog ; do an exponentiated label
If (x >= tempminx) And (x <= tempmaxx)
SetTextJustify(#CenterText, #TopText)
INC(yloc, y_location+13) ; position the "10"
OutTextXY(xloc,yloc,"10")
tempheight = TextHeights("10") + Int(TextHeights(labl)-4)
DEC(yloc, Int(tempheight / 2))
INC(xloc, Int(TextWidths("10") / 2) + 3)
tempheight = Int(tempheight / 2) + Int(TextHeights(labl)) ; pixel height of label
SetTextJustify(#LeftText,#TopText)
OutTextXY(xloc,yloc,labl)
EndIf ; IF ((x >= tempminx...
x = x*10.0
Else ; straight linear label
INC(yloc,y_location)
OutTextXY(xloc,yloc,labl)
tempheight = TextHeights(labl)
INC(x+LabelX)
EndIf ; IF (XAxisLog)...
If tempheight > MaxLabHeight
MaxLabHeight = tempheight
EndIf
Wend ; WHILE
; label y axis
MaxLabLength = 0 ; initialize this offset for YAxisTitle
templength = 0
SetTextJustify(#RightText,#CenterText)
y = tempminy
If YAxisLog
y = Pow(10.0,Log10(tempminy))
EndIf
While y <= tempmaxy
If YAxisLog
labl = StrD(Log10(y), 3) ; was 6
Else
labl = StrD(y, 3) ; was 5
EndIf
labl = Remove_Zeros(labl)
World_to_Window(XWorldMin,y,@xloc,@yloc)
If YAxisLog ; do an exponentiated label
If (y >= tempminy) And (y <= tempmaxy)
SetTextJustify(#RightText,#CenterText)
templength = TextWidths("10") + Int(TextWidths(labl)/2)
DEC(xloc,x_location-templength) ; position the "10"
OutTextXY(xloc,yloc,"10")
templength = templength + Int(TextWidths(labl)) ; pixel width of label
DEC(yloc,Int(TextHeights("10") / 2))
INC(xloc,2)
SetTextJustify(#LeftText,#CenterText)
OutTextXY(xloc,yloc,labl)
EndIf ; IF ((y >= tempminy...
y = y * 10.0
Else ; straight linear label
DEC(xloc,x_location)
OutTextXY(xloc,yloc,labl)
templength = TextWidths(labl)
INC(y,LabelY)
EndIf
If (templength > MaxLabLength)
MaxLabLength = templength
EndIf
Wend
; restore defaults
SetClipOn()
EndProcedure
; Plots a Symbol, scaled by SymSize, centered at world coordinates
; X,Y; available Symbols are:
; 1 - plus
; 2 - box
; 3 - cross (x-like)
; 4 - triangle
; 5 - inverted triangle
; 6 - open circle
; 7 - filled circle
; 8 - dot
Procedure PlotPoint(X.d,Y.d, Symbol.i, SymSize.i, color.i)
Protected.i del = 1
Protected.i xs,ys,delta,x1,y1
Protected.i curcol
x1 = GetX()
y1 = GetY()
curcol = GetColor()
SetColor(color)
World_to_Window(X,Y,@xs,@ys)
delta = del*SymSize;
Select Symbol
Case 1 ; plus
MoveTo(xs-delta,ys)
LineRel(2*delta,0)
MoveRel(-delta,-delta)
LineRel(0,2*delta)
Case 2 ; box
MoveTo(xs-delta,ys-delta)
LineRel(2*delta,0)
LineRel(0,2*delta)
LineRel(-2*delta,0)
LineRel(0,-2*delta)
Case 3 ; cross
MoveTo(xs-delta,ys-delta)
LineRel(2*delta,2*delta)
MoveRel(-2*delta,0)
LineRel(2*delta,-2*delta)
Case 4: ; triangle
MoveTo(xs,Int(ys-delta-delta / 3))
LineRel(-delta,2*delta)
LineRel(2*delta,0)
LineRel(-delta,-2*delta)
Case 5 ; inverted triangle
MoveTo(xs,Int(ys+delta+delta / 3))
LineRel(-delta,-2*delta)
LineRel(2*delta,0)
LineRel(-delta,2*delta)
Case 6
Circles(xs,ys,delta) ; open circle
Case 7
FillEllipse(xs,ys,delta,delta, color) ; closed circle
Case 8
PutPixel(xs,ys,GetMaxColor()) ; unscaled point
Default
EndSelect
MoveTo(x1,y1)
SetColor(curcol)
EndProcedure
; Procedure To set up the graph limits.
; The world coordinate limits are XMin, XMax, YMin, And YMax.
; The window limits are WXMin, WXMax, WYMin, WYMax expressed As
; fractions (of 1,i.e. 0.95 etc) of the maximum screen limits.
Procedure Setup_Graph(XMin.d,XMax.d,YMin.d,YMax.d, WXMin.d,WXMax.d,WYMin.d,WYMax.d,logx.b,logy.b)
If logx = #True
XAxisLog = #True
Else
XAxisLog = #False
EndIf
If logy = #True
YAxisLog = #True
Else
YAxisLog = #False
EndIf
; set global variables for other graphics routines.
XWorldMin = XMin
XWorldMax = XMax
YWorldMin = YMin
YWorldMax = YMax
Setscale(WXMin,WXMax,WYMin,WYMax)
; initialize some global constants just in case Label_Axes is not called
MaxLabLength = 0
MaxLabHeight = 0
; set up defaults for graphics parameters
SetClipOn()
Custom_LineStyle(0) = $0FFFF
Custom_LineStyle(1) = $5555
Custom_LineStyle(2) = $0F0F
Custom_LineStyle(3) = $1111
Custom_LineStyle(4) = $1010
EndProcedure
; Plots a Symbol, scaled by SymSize, centered at world coordinates
; X,Y; error bar on X,Y are sigx and sigy; available Symbols are:
; 1 - plus
; 2 - box
; 3 - cross (x-like)
; 4 - triangle
; 5 - inverted triangle
; 6 - open circle
; 7 - filled circle
; 8 - dot
Procedure PlotData(x.d,sigx.d,y,sigy.d, Symbol.i, SymSize.i, color.i)
Protected.i del = 1
Protected.i xs,ys,delta,xx,yy
PlotPoint(x,y,Symbol,SymSize, color)
delta = del*SymSize
xx = GetX()
yy = GetY()
If (sigx > 0.0) ; do x error bar
Move(x+sigx,y)
Draw(x-sigx,y)
World_to_Window(x+sigx,y,@xs,@ys)
MoveTo(xs,ys-delta)
LineRel(0,2*delta)
World_to_Window(x-sigx,y,@xs,@ys)
MoveTo(xs,ys-delta)
LineRel(0,2*delta)
EndIf
If (sigy > 0.0) ; do y error bar
Move(x,y+sigy)
Draw(x,y-sigy)
World_to_Window(x,y+sigy,@xs,@ys)
MoveTo(xs-delta,ys)
LineRel(2*delta,0)
World_to_Window(x,y-sigy,@xs,@ys)
MoveTo(xs-delta,ys)
LineRel(2*delta,0)
EndIf
MoveTo(xx,yy)
EndProcedure
EndModule
