Math function graph

[Michael Vogel]

I needed a program to show some math functions, so I wrote a small program doing so.

Grabbed some code from infratec (split), stargate (plot) and utopiomania (eval) and added some lines by myself...
...should be DPI aware and there's also a small hope it could work on Linux and Mac computers.

Some shortcuts:
(Shift) Tab - jump to next function
(Shift) Space - change visibility
Return - change function
Ctrl+# - select function
Ctrl+N - add new function
Ctrl+D - delete function
Ctrl+L - line width
Ctrl X/Y - change visible range
Cursor - move graph

Code: Select all

; Define Eval

	EnableExplicit

	#EvalOptimizer=	1

	Global EvalExpression.s
	Global EvalStep.i
	Global EvalToken.s
	Global EvalTokenType.i
	Global EvalError.i

	#EvalNewLine=		":"

	#EvalMaxVariables=	100
	Global Dim EvalVarName.s(#EvalMaxVariables)
	Global Dim EvalVarVal.d(#EvalMaxVariables)

	#EvalFunctionList=" COS ACOS SIN ASIN TAN ATAN ABS INT SQR LOG LOG10 "

	Enumeration TokenTypes #True
		#EvalDelimiter
		#EvalVariable
		#EvalNumber
		#EvalFunction
		#EvalCommand
	EndEnumeration

	Enumeration ErrorTypes
		#EvalNoError
		#EvalErrorDivisionByZero
		#EvalErrorSyntax
		#EvalErrorParenthesis
		#EvalErrorNoExpression
		#EvalErrorCharacters
	EndEnumeration

	Macro ExitIf(condition)
		If condition
			Break
		EndIf
	EndMacro

	Procedure isDelim(str.s)

		If (FindString("&|<>+/*^=", str, 1) > 0) And (str <> "")
			ProcedureReturn #True
		EndIf

		ProcedureReturn #False

	EndProcedure
	Procedure NotDelim(str.s)

		If (FindString("&|<>+-/*^=() "+#EvalNewLine, str, 1) > 0) Or (str = "")
			ProcedureReturn #False
		EndIf

		ProcedureReturn #True

	EndProcedure
	Procedure notVailidop(op.s)

		If Len(op) = 1
			ProcedureReturn #False
		EndIf

		Select EvalToken
		Case "<>"
			ProcedureReturn #False
		Case "<="
			ProcedureReturn #False
		Case ">="
			ProcedureReturn #False
		Case "=="
			ProcedureReturn #False
		Case "--"
			ProcedureReturn #False
		EndSelect

		ProcedureReturn #True

	EndProcedure
	Procedure isErr(str.s)

		;Check for some errors
		Protected str1.s
		Protected str2.s
		Protected err = 0
		Protected i
		str = UCase(str)

		;Check for unbalanced parentheses
		For i = 1 To Len(str)
			If Mid(str, i, 1) = "("
				err + 1
			EndIf
			If Mid(str, i, 1) = ")"
				err - 1
			EndIf
		Next

		If err
			EvalError=#EvalErrorParenthesis
			ProcedureReturn EvalError
		EndIf

		;Check for Illegal characters
		str1 = " ABCDEFGHIJKLMNOPQRSTUVWXYZ"
		str2 = "0123456789.&|<>+-/%*^=()" + #EvalNewLine
		For i = 1 To Len(str)
			If FindString(str1 + str2, Mid(str, i, 1), 1) = 0
				Debug Mid(str, i, 1)
				Debug #EvalNewLine
				err + 1
			EndIf
		Next

		If err
			EvalError=#EvalErrorCharacters
			ProcedureReturn EvalError
		EndIf

		ProcedureReturn EvalError

	EndProcedure

	Procedure.d letVar(var.s, num.d)

		;assign a value to a variable
		Protected i = 0

		While Len(EvalVarName(i))
			If var = EvalVarName(i)
				EvalVarVal(i) = num
				ProcedureReturn num
			EndIf
			i + 1
		Wend

		EvalVarName(i) = var
		EvalVarVal(i) = num

		ProcedureReturn num

	EndProcedure
	Procedure.d getVar()

		;find value of a variable
		Protected i = 0

		While Len(EvalVarName(i))
			If EvalToken = EvalVarName(i)
				ProcedureReturn EvalVarVal(i)
			EndIf
			i + 1
		Wend

		letVar(EvalToken, 0)
		ProcedureReturn getVar()

	EndProcedure
	Procedure getToken()

		Protected look.i
		Protected item.s

		;get the next token/token type in expression
		EvalTokenType = 0
		EvalToken = ""
		If EvalStep > Len(EvalExpression)
			ProcedureReturn
		EndIf

		item=Mid(EvalExpression,EvalStep,1)
		look=PeekC(@item)

		If look='-';							isMinus(item)
			EvalTokenType=	#EvalDelimiter
			EvalToken=	item
			EvalStep+1

		ElseIf look='(' Or look=')';				isParenth(item)
			EvalTokenType=	#EvalDelimiter
			EvalToken=	item
			EvalStep+1

		ElseIf look And FindString("&|<>+/*^=",item); isDelim(item)
			EvalTokenType=	#EvalDelimiter
			look=EvalStep
			Repeat
				look+1
				item=Mid(EvalExpression,look,1)
			Until isDelim(item)=#Null
			EvalToken+Mid(EvalExpression,EvalStep,look-EvalStep)
			EvalStep=look
			If notVailidop(EvalToken)
				EvalError=#EvalErrorSyntax
			EndIf

		ElseIf look>='A' And look<='Z';			isAlpha(item)
			look=EvalStep
			Repeat
				look+1
				item=Mid(EvalExpression,look,1)
			Until notDelim(item)=#Null
			EvalToken+Mid(EvalExpression,EvalStep,look-EvalStep)
			EvalStep=look

			If FindString(#EvalFunctionList," "+EvalToken+" ");	isFunc(EvalToken)
				EvalTokenType= #EvalFunction
			Else
				EvalTokenType = #EvalVariable
			EndIf

		ElseIf look>='.' And look<='9';			isDigit(item) - sollte funktionieren, da '/' schon weiter oben geprüft wird
			EvalTokenType=	#EvalNumber
			look=EvalStep
			Repeat
				look+1
				item=Mid(EvalExpression,look,1)
			Until notDelim(item)=#Null
			EvalToken+Mid(EvalExpression,EvalStep,look-EvalStep)
			EvalStep=look

		EndIf

	EndProcedure
	Procedure rewind()

		;back up to the previous token
		EvalStep = EvalStep - Len(EvalToken)

	EndProcedure
	Procedure.d primitive()

		;find value of number or variable
		Protected result.d

		Select EvalTokenType
		Case #EvalVariable
			result = getVar()
			gettoken()
		Case #EvalNumber
			result = ValF(EvalToken)
			gettoken()
		Default
			EvalError = #EvalErrorSyntax
		EndSelect

		ProcedureReturn result

	EndProcedure
	Procedure.d unary(op.s, num.d)
		;unary minus
		If op = "-"
			ProcedureReturn -num
		EndIf
		ProcedureReturn num
	EndProcedure
	Procedure.d calc(op.s, num1.d, num2.d)

		Protected result.d

		Select op
		Case "&"
			result = Bool(num1 And num2)
		Case "|"
			result = Bool(num1 Or num2)
		Case "<"
			If num1 < num2
				result = 1
			EndIf
		Case ">"
			If num1 > num2
				result = 1
			EndIf
		Case "<>"
			If num1 <> num2
				result = 1
			EndIf
		Case "<="
			If num1 <= num2
				result = 1
			EndIf
		Case ">="
			If num1 >= num2
				result = 1
			EndIf
		Case "=="
			If num1 = num2
				result = 1
			EndIf
		Case "-"
			result = num1 - num2
		Case "+"
			result = num1 + num2
		Case "*"
			result = num1 * num2
		Case "/"
			If num2 <> 0
				result = num1 / num2
			Else
				EvalError = #EvalErrorDivisionByZero
				result = 0
			EndIf
		Case "^"
			result = Pow(num1, num2)
		Case "ACOS"
			result = ACos(num1)
		Case "ASIN"
			result = ASin(num1)
		Case "ATAN"
			result = ATan(num1)
		Case "ABS"
			result = Abs(num1)
		Case "COS"
			result = Cos(num1)
		Case "INT"
			result = Int(num1)
		Case "LOG"
			result = Log(num1)
		Case "LOG10"
			result = Log10(num1)
		Case "SIN"
			result = Sin(num1)
		Case "SQR"
			result = Sqr(num1)
		Case "TAN"
			result = Tan(num1)
		EndSelect

		ProcedureReturn result
	EndProcedure

	Declare.d level1()
	Procedure.d level9()

		;parenthesized expression
		Protected result.d

		If (EvalTokenType = #EvalDelimiter) And (EvalToken = "(")
			gettoken()
			result = level1()
			gettoken()
		Else
			result = primitive()
		EndIf

		ProcedureReturn result
	EndProcedure
	Procedure.d level8()

		Protected result.d
		Protected op.s; = ""

		;functions

		If EvalTokenType = #EvalFunction
			op = EvalToken
			gettoken()
		EndIf

		result=level9()
		If Len(op)
			result = calc(op, result, 0)
		EndIf

		ProcedureReturn result

	EndProcedure
	Procedure.d level7()

		Protected result.d
		Protected op.s; = ""

		;unary plus or minus
		If (EvalTokenType = #EvalDelimiter) And ((EvalToken = "+") Or (EvalToken = "-"))
			op = EvalToken
			gettoken()
		EndIf

		result=level8()
		If Len(op)
			result = Unary(op, result)
		EndIf

		ProcedureReturn result

	EndProcedure
	Procedure.d level6()

		;Exponent
		Protected result.d=level7()
		If EvalToken = "^"
			gettoken()
			result = calc("^", result, level7())
		EndIf

		ProcedureReturn result

	EndProcedure
	Procedure.d level5()

		;multiply,  divide
		Protected result.d=level6()

		Protected op.s = EvalToken

		While (op = "*") Or (op = "/")
			gettoken()
			result = calc(op, result, level6())
			op = EvalToken
		Wend

		ProcedureReturn result

	EndProcedure
	Procedure.d level4()

		;add or subtract two terms
		Protected result.d = level5()

		Protected op.s = EvalToken

		While (op = "+") Or (op = "-")
			gettoken()
			result = calc(op, result, level5())
			op = EvalToken
		Wend

		ProcedureReturn result

	EndProcedure
	Procedure.d level3()

		;conditional operators
		Protected result.d = level4()
		Protected op.s = EvalToken

		While (op = "<") Or (op = ">") Or (op = "<>") Or (op = "<=") Or (op = ">=") Or (op = "==")
			gettoken()
			result = calc(op, result, level4())
			op = EvalToken
		Wend

		ProcedureReturn result

	EndProcedure
	Procedure.d level2()

		;logical  and/or
		Protected result.d = level3()
		Protected op.s = EvalToken

		While (op = "&") Or (op = "|")
			gettoken()
			result = calc(op, result, level3())
			op = EvalToken
		Wend

		ProcedureReturn result

	EndProcedure
	Procedure.d level1()

		;assignment statement/command
		Protected typ.i;	war .l
		Protected tok.s

		If EvalTokenType=#EvalVariable
			;Save old token
			tok = EvalToken
			typ = EvalTokenType
			gettoken()
			If EvalToken = "="
				;assignment
				gettoken()
				ProcedureReturn letVar(tok, level2())
			Else
				;Restore
				Rewind()
				EvalToken = tok
				EvalTokenType = Typ
			EndIf

		EndIf

		ProcedureReturn level2()

	EndProcedure

	Procedure initeval()

		; Special
		EvalVarName(0) = "X"
		EvalVarVal(0) = 0
		EvalVarName(1) = "PI"
		EvalVarVal(1) = #PI
		EvalVarName(2) = "E"
		EvalVarVal(2) = Exp(1)

	EndProcedure
	Procedure.d eval(str.s,xval.d,*error.Integer=#Null)

		; X
		EvalVarVal(0) = xval

		;entry point into parser
		EvalStep = 1
		EvalError = #EvalNoError
		EvalExpression = UCase(str)
		gettoken()
		If EvalToken = ""
			EvalError =#EvalErrorNoExpression
		EndIf

		isErr(EvalExpression)
		If EvalError
			If *error
				*error\i=EvalError
			EndIf
			ProcedureReturn #Null
		EndIf

		ProcedureReturn level1()

	EndProcedure

; EndDefine
; Define App

	EnableExplicit

	Enumeration
		#Window
		#Canvas
		#Info
		#Edit
		#Font
		#FontInfo
		#Image

		#KeyTab
		#KeyTabShift
		#KeySpace
		#KeyOuterSpace
		#KeyReturn
		#KeyEscape
		#KeyScrollUp
		#KeyScrollDown
		#KeyScrollLeft
		#KeyScrollRight
		#KeyZoomIn
		#KeyZoomOut
		#KeyEditName
		#KeyEditLine
		#KeyEditPrecision
		#KeyEditRangeX
		#KeyEditRangeY

		#KeyDelFunction
		#KeyNewFunction
		#KeyCopyClipboard
		#KeyControl1
		#KeyControl2
		#KeyControl3
		#KeyControl4
		#KeyControl5
		#KeyControl6
	EndEnumeration

	Enumeration
		#EditOff
		#EditAccept
		#EditExit
		#EditFunction
		#EditName
		#EditLine
		#EditPrecision
		#EditRangeX
		#EditRangeY
	EndEnumeration


	#DrawOpaque=	$FF000000
	#DrawStrong=	$C0000000
	#DrawMedium=	$80000000
	#DrawLight=	$20000000
	#ColorBack=	#White
	#ColorTitle=	$604040
	#ColorText=	#Black
	#ColorHidden=	$C0B0B0
	#ColorGrid=	$C0C0C0
	#ColorAxis=	$000000
	#ColorSpacer=	$808080
	#ColorFn1=	$C06000
	#ColorFn2=	$2020C0
	#ColorFn3=	$008000
	#ColorFn4=	$0090E0
	#ColorFn5=	$A000E0
	#ColorFn6=	$F00060


	#PB_DpiBits=	16
	#PB_DpiScale=	1<<#PB_DpiBits


	Structure Vector
		X.d
		Y.d
	EndStructure

	Structure PlotType
		WinWidth.i
		WinHeight.i
		DpiScale.i
		Width.i
		Height.i
		Border.i
		Top.i
		Bottom.i
		ZoomX.d
		ZoomY.d
		RangeX.d
		RangeY.d
		OffsetX.d
		OffsetY.d
		AxisX.d
		AxisY.d
		TranslateX.d
		TranslateY.d
		MinX.d
		MaxX.d
		MinY.d
		MaxY.d
		Grid.i;		0,1,2: off, normal, fine
		Text.i;		0,1,2: off, large, small
		Precision.i;	0-5
		AllowErr.i;	0 / 1:	Division durch Null durchgehen lassen
		EditMode.i
		FncActive.i
		FncCount.i
	EndStructure

	Structure FunctionType
		Name.s
		Formula.s
		Color.i
		Visible.i
		Filled.i
		LineWidth.d
	EndStructure

	#MaxFunctions=6

	Global Plot.PlotType
	Global Dim Funct.FunctionType(#MaxFunctions)

; EndDefine

Procedure.i Split(String.s, Array StringArray.s(1), Separator.s=#EvalNewLine)

	Protected S.String
	Protected *S.Integer=@S
	Protected.i asize,i,p,slen

	asize=CountString(String,Separator)
	slen=Len(Separator)

	ReDim StringArray(asize)

	*S\i=@String
	While i<asize
		p=FindString(S\s,Separator)
		StringArray(i)=PeekS(*S\i,p-1)
		*S\i+(p+slen-1)<<#PB_Compiler_Unicode
		i+1
	Wend

	StringArray(i)=S\s
	*S\i=0

	ProcedureReturn asize

EndProcedure
Procedure.d Range(val,min,max)

	If val>max
		ProcedureReturn max
	ElseIf val<min
		ProcedureReturn min
	Else
		ProcedureReturn val
	EndIf

EndProcedure
Procedure.d GridSize(val.d)

	Protected n.d

	n=Pow(10,Round(Log10(val),#PB_Round_Down))

	If n*5<val
		ProcedureReturn n*5
	ElseIf n*2.5<val
		ProcedureReturn n*2.5
	Else
		ProcedureReturn n
	EndIf

EndProcedure
Macro PX(x)

	Plot\TranslateX+x*Plot\ZoomX

EndMacro
Macro PY(y)

	Plot\TranslateY+y*-Plot\ZoomY

EndMacro
Macro DontPanic(variable)

	If IsNAN(variable); Or IsInfinity(variable)
		variable=0
	EndIf

EndMacro
Macro ScaleUp(value)
	(((value)*Plot\DpiScale)>>#PB_DpiBits)
EndMacro
Macro ScaleDown(value)
	(((value)<<#PB_DpiBits)/Plot\DpiScale)
EndMacro

Procedure CalcFunction(List Node.Vector(),function.s,samples.i=100)

	Protected.i f,n,m
	Protected.i tuning,depth,maxdepth
	Protected.d min,delta
	Protected.d Resolution
	Protected.Vector *P1, P2, *P3
	Protected.i Error
	Protected Dim Fns.s(0)


	min=Plot\MinX
	delta=Plot\MaxX-min
	Resolution=1/Plot\Width

	function=ReplaceString(function," ","")

	f=CountString(function,#EvalNewLine)
	If f
		Split(function,Fns())
	EndIf

	Debug function

	n=0
	While n<=samples
		AddElement(Node())
		Node()\X = min + delta*n/Samples
		If f
			m=0
			While m<=f And EvalError<=Plot\AllowErr
				Node()\Y=eval(Fns(m),Node()\X,@EvalError)
				DontPanic(Node()\Y)
				m+1
			Wend
		Else
			Node()\Y=eval(function,Node()\X,@EvalError)
		EndIf
		DontPanic(Node()\Y)

		ExitIf (EvalError>Plot\AllowErr)
		n+1
	Wend

	Debug "Path 1"

	tuning=Bool(Plot\Precision)
	If Plot\Precision>1
		maxdepth=Plot\Precision-1
	EndIf

	If EvalError<=Plot\AllowErr

		FirstElement(Node())
		*P1=Node();							L=[1]

		While NextElement(Node())
			*P3=Node();						R=[2]
			P2\X=(*P1\X+*P3\X)/2

			If f
				m=0
				While m<=f
					P2\Y=eval(Fns(m),P2\X,@EvalError)
					DontPanic(P2\Y)
					m+1
				Wend
			Else
				P2\Y=eval(function,P2\X,@EvalError)
				DontPanic(P2\Y)
			EndIf


			If tuning And Abs((*P1\Y+*P3\Y-2*P2\Y)) > Resolution/Abs(*P1\X-*P3\X)
				depth+1
				InsertElement(Node());			[1} [N] [2]
				Node()=P2
				If maxdepth
					If depth>=maxdepth
						*P1=Node();			L=[N]
					EndIf
					PreviousElement(Node());		> [N]
				Else
					*P1=*P3;					L=[2]
				EndIf
			Else
				*P1=*P3;						L=[2]
				depth=0
			EndIf
		Wend

	EndIf

	Debug "Path 2"

	ProcedureReturn EvalError

EndProcedure
Procedure DrawAxis()

	Protected.i n
	Protected.i g,k,l

	Protected.d x,y,z
	Protected.d w,h
	Protected.d gx,gy
	Protected.d ox,oy
	Protected.d mx,my
	Protected.d sx,sy

	Protected.s s


	With Plot

		VectorSourceColor(#ColorBack|#DrawOpaque);	Löschen
		FillVectorOutput()
		TranslateCoordinates(0.5,0.5);			Pixel-Offset für "saubere" Linien

		VectorFont(FontID(#Font),16.0);			Beschriftung

		w=\Width-2*\Border;						Größe des Plotbereichs in Pixel
		h=\Height-\Top-\Bottom

		\RangeX=\MaxX-\MinX;					Plotbereich (nicht Null!)
		\RangeY=\MaxY-\MinY

		\ZoomX=w/\RangeX;						Zoom-Faktor (reale Werte > Pixel)
		\ZoomY=h/\RangeY

		\OffsetX=-\MinX*\ZoomX;					Offset zum Ursprung (0|0)
		\OffsetY=\MaxY*\ZoomY;					Y-Koordinatensystem spiegeln (0=unten)

		\AxisX=Range(\OffsetX,0,w)+\Border;		Achsenposition
		\AxisY=Range(\OffsetY,0,h)+\Top

		\TranslateX=\OffsetX+\Border
		\TranslateY=\OffsetY+\Top


		gx=GridSize(\RangeX/24);					Raster
		gy=GridSize(\RangeY/24)
		x=Round(\MinX/gx,#PB_Round_Down)*gx
		z=Round(\MinY/gy,#PB_Round_Down)*gy

		While x<=\MaxX
			g=Bool(x=Int(x))
			y=z
			While y<=\MaxY

				k=1+2*Bool(g And y=Int(y))
				l=k*2+1
				MovePathCursor(PX(x)-k,PY(y))
				AddPathLine(l,0,#PB_Path_Relative)
				MovePathCursor(PX(x),PY(y)-k)
				AddPathLine(0,l,#PB_Path_Relative)
				y+gy
			Wend
			x+gx
		Wend
		VectorSourceColor(#DrawOpaque|#ColorGrid)
		StrokePath(0.3)


		VectorSourceColor(#DrawOpaque|#ColorAxis);	X-Achse
		gx=GridSize(\RangeX/12)
		gy=GridSize(\RangeY/12)

		x=Round(\MinX/\RangeX,#PB_Round_Down)*\RangeX
		If x<\MinX
			x+gx
		EndIf
		While x<=\MaxX
			s=StrD(x)
			If s="-0" : s="0" : EndIf
			If s="0" : n=#True : EndIf
			z=PX(x)
			MovePathCursor(z-VectorTextWidth(s)/2,\AxisY+5)
			AddPathText(s)
			FillPath(#PB_Path_Winding)
			MovePathCursor(z,\AxisY-5)
			AddPathLine(0,8,#PB_Path_Relative)
			StrokePath(1,#PB_Path_SquareEnd)
			x+gx
		Wend

		y=Round(\MinY/gy,#PB_Round_Down)*gy;		Y-Achse
		If y<\MinY
			y+gy
		EndIf
		While y<=\MaxY
			s=StrD(y)
			If n=#Null Or s<>"0"
				z=PY(y)
				MovePathCursor(\AxisX+8,z-VectorTextHeight(s)/2)
				AddPathText(s)
				FillPath(#PB_Path_Winding)
				MovePathCursor(\AxisX-5,z)
				AddPathLine(8,0,#PB_Path_Relative)
				StrokePath(1,#PB_Path_SquareEnd)
			EndIf
			y+gy
		Wend

		MovePathCursor(\AxisX,\Top)
		AddPathLine(0,h,#PB_Path_Relative)
		MovePathCursor(\Border,\AxisY)
		AddPathLine(w,0,#PB_Path_Relative)
		StrokePath(1,#PB_Path_SquareEnd)

		;AddPathCircle(PX(0),PY(0),5)
		;AddPathCircle(PX(10),PY(0),3)
		;AddPathCircle(PX(0),PY(10),3)
		;StrokePath(1)

	EndWith

EndProcedure
Procedure DrawInformation()

	Protected.i i,n,t
	Protected.d spc,pos,len
	Protected.d height
	Protected.s s


	#BoxLen=16
	#BoxSpace=10

	With Plot

		AddPathBox(0,0,\Width,\Top)
		AddPathBox(0,\Height-\Bottom,\Width,\Bottom)
		VectorSourceColor(#ColorBack|#DrawStrong)
		FillPath()

		VectorFont(FontID(#Font),30.0);			Kopfzeile
		s="Function Graph by Michael Vogel"
		MovePathCursor((\Width-VectorTextWidth(s))/2,(\Top-VectorTextHeight(s))/2)
		AddPathText(s)
		VectorSourceColor(#DrawOpaque|#ColorTitle)
		FillPath(#PB_Path_Winding)

		VectorFont(FontID(#Font),18)

		height=VectorTextHeight(":")
		spc=(\Width-\Border*2)/\FncCount

		For i=1 To \FncCount
			s=Funct(i)\Formula
			n=Len(s)
			t=#Null
			Repeat
				If t
					s=Left(s,n)+"..."
				EndIf
				t=#True
				n-2
				len=VectorTextWidth(s)
			Until len<spc-#BoxLen-#BoxSpace

			MovePathCursor(\Border+(i-1)*spc+#BoxLen+#BoxSpace,\Height-\Bottom+(\Bottom-height)/2)
			AddPathText(s)
			If Funct(i)\Visible
				VectorSourceColor(#DrawOpaque|#ColorText)
			Else
				VectorSourceColor(#DrawOpaque|#ColorHidden)
			EndIf
			FillPath(#PB_Path_Winding)
		Next i

		For i=1 To \FncCount
			AddPathBox(\Border+(i-1)*spc,\Height-\Bottom+(\Bottom-height)/2,#BoxLen,height)
			VectorSourceColor(Funct(i)\Color|#DrawMedium)
			FillPath(#PB_Path_Preserve)
			VectorSourceColor(Funct(i)\Color|#DrawOpaque)
			StrokePath(1,#PB_Path_SquareEnd)
		Next i

		MovePathCursor(\Border,\Top)
		AddPathLine(\Width-\Border*2,0,#PB_Path_Relative)
		MovePathCursor(\Border,\Height-\Bottom)
		AddPathLine(\Width-\Border*2,0,#PB_Path_Relative)
		VectorSourceColor(#DrawMedium|#ColorSpacer)
		StrokePath(1,#PB_Path_SquareEnd)

	EndWith

EndProcedure
Procedure DrawFunction(number)

	Protected NewList Node.Vector()
	Protected.d x,y
	Protected Error.i

	Error=CalcFunction(Node(),Funct(number)\Formula,Plot\Width/8)

	If Error=#EvalNoError

		VectorSourceColor(#DrawOpaque|Funct(number)\Color)
		ForEach Node()
			X=PX(Node()\X)
			Y=PY(Node()\Y)
			If ListIndex(Node())
				AddPathLine(X,Y)
			Else
				MovePathCursor(X,Y)
			EndIf
		Next
		If Funct(number)\Filled
			StrokePath(Funct(number)\LineWidth,#PB_Path_RoundCorner|#PB_Path_Preserve)
			AddPathLine(X,PY(0))
			FirstElement(Node())
			AddPathLine(PX(Node()\X),PY(0))
			ClosePath()
			VectorSourceColor(#DrawLight|Funct(number)\Color)
			FillPath()
		Else
			StrokePath(Funct(number)\LineWidth,#PB_Path_RoundCorner)
		EndIf

	EndIf

	ProcedureReturn EvalError

EndProcedure
Procedure DrawCursor(mode)

	Protected.d spc

	If mode
		StartVectorDrawing(CanvasVectorOutput(#Canvas))
	EndIf

	spc=(Plot\Width-Plot\Border*2)/Plot\FncCount

	AddPathBox(0,Plot\Height-5,Plot\Width-5,5)
	VectorSourceColor(#DrawOpaque|#ColorBack)
	FillPath()

	AddPathBox(Plot\Border+(Plot\FncActive-1)*spc,Plot\Height-5,spc-5,5)
	VectorSourceColor(#DrawOpaque)
	FillPath()

	If mode
		StopVectorDrawing()
	EndIf

EndProcedure
Procedure DrawCanvas()

	Protected.i i

	With Plot

		\WinWidth=WindowWidth(#Window)
		\WinHeight=WindowHeight(#Window)
		\Width=	ScaleUp(\WinWidth)
		\Height=	ScaleUp(\WinHeight)

		ResizeGadget(#Canvas,0,0,\Width,\Height)
		ResizeGadget(#Info,ScaleDown(\Border),ScaleDown(\Height-\Bottom-30),ScaleDown(\Width-2*\Border),ScaleDown(30))
		ResizeGadget(#Edit,ScaleDown(\Border),ScaleDown(\Height-\Bottom*13/16),ScaleDown(\Width-2*\Border),ScaleDown(\Bottom*10/16))

		If StartVectorDrawing(CanvasVectorOutput(#Canvas,#PB_Unit_Pixel))
			DrawAxis()
			For i=1 To \FncCount
				If Funct(i)\Visible
					DrawFunction(i)
				EndIf
			Next i
			DrawInformation()
			DrawCursor(#Null)
			StopVectorDrawing()
		EndIf

	EndWith

EndProcedure
Procedure CopyCanvas()

	StartDrawing(CanvasOutput(#Canvas))
	GrabDrawingImage(#Image,0,0,OutputWidth(), OutputHeight())
	StopDrawing()
	SetClipboardImage(#Image)

EndProcedure

Procedure Shortcuts(mode)


	If mode
		AddKeyboardShortcut(#Window,#PB_Shortcut_Space,#KeySpace)
		AddKeyboardShortcut(#Window,#PB_Shortcut_Space|#PB_Shortcut_Shift,#KeyOuterSpace)
		AddKeyboardShortcut(#Window,#PB_Shortcut_Tab,#KeyTab)
		AddKeyboardShortcut(#Window,#PB_Shortcut_Tab|#PB_Shortcut_Shift,#KeyTabShift)

		AddKeyboardShortcut(#Window,#PB_Shortcut_Up,#KeyScrollUp)
		AddKeyboardShortcut(#Window,#PB_Shortcut_Down,#KeyScrollDown)
		AddKeyboardShortcut(#Window,#PB_Shortcut_Left,#KeyScrollLeft)
		AddKeyboardShortcut(#Window,#PB_Shortcut_Right,#KeyScrollRight)
		AddKeyboardShortcut(#Window,#PB_Shortcut_Add,#KeyZoomIn)
		AddKeyboardShortcut(#Window,#PB_Shortcut_Subtract,#KeyZoomOut)

		AddKeyboardShortcut(#Window,#PB_Shortcut_Z,#KeyZoomIn)
		AddKeyboardShortcut(#Window,#PB_Shortcut_Z|#PB_Shortcut_Shift,#KeyZoomOut)

		AddKeyboardShortcut(#Window,#PB_Shortcut_C|#PB_Shortcut_Control,#KeyCopyClipboard)
		AddKeyboardShortcut(#Window,#PB_Shortcut_D|#PB_Shortcut_Control,#KeyDelFunction)
		AddKeyboardShortcut(#Window,#PB_Shortcut_L|#PB_Shortcut_Control,#KeyEditLine)
		AddKeyboardShortcut(#Window,#PB_Shortcut_N|#PB_Shortcut_Control,#KeyNewFunction)
		AddKeyboardShortcut(#Window,#PB_Shortcut_P|#PB_Shortcut_Control,#KeyEditPrecision)
		AddKeyboardShortcut(#Window,#PB_Shortcut_R|#PB_Shortcut_Control,#KeyEditName)
		AddKeyboardShortcut(#Window,#PB_Shortcut_X|#PB_Shortcut_Control,#KeyEditRangeX)
		AddKeyboardShortcut(#Window,#PB_Shortcut_Y|#PB_Shortcut_Control,#KeyEditRangeY)

		For mode=0 To #MaxFunctions-1
			AddKeyboardShortcut(#Window,#PB_Shortcut_1+mode|#PB_Shortcut_Control,#KeyControl1+mode)
		Next mode

	Else
		RemoveKeyboardShortcut(#Window,#PB_Shortcut_Space)
		RemoveKeyboardShortcut(#Window,#PB_Shortcut_Space|#PB_Shortcut_Shift)
		RemoveKeyboardShortcut(#Window,#PB_Shortcut_Tab)
		RemoveKeyboardShortcut(#Window,#PB_Shortcut_Tab|#PB_Shortcut_Shift)

		RemoveKeyboardShortcut(#Window,#PB_Shortcut_Up)
		RemoveKeyboardShortcut(#Window,#PB_Shortcut_Down)
		RemoveKeyboardShortcut(#Window,#PB_Shortcut_Left)
		RemoveKeyboardShortcut(#Window,#PB_Shortcut_Right)
		RemoveKeyboardShortcut(#Window,#PB_Shortcut_Add)
		RemoveKeyboardShortcut(#Window,#PB_Shortcut_Subtract)

		RemoveKeyboardShortcut(#Window,#PB_Shortcut_Z)
		RemoveKeyboardShortcut(#Window,#PB_Shortcut_Z|#PB_Shortcut_Shift)

		RemoveKeyboardShortcut(#Window,#PB_Shortcut_C|#PB_Shortcut_Control)
		RemoveKeyboardShortcut(#Window,#PB_Shortcut_D|#PB_Shortcut_Control)
		RemoveKeyboardShortcut(#Window,#PB_Shortcut_L|#PB_Shortcut_Control)
		RemoveKeyboardShortcut(#Window,#PB_Shortcut_N|#PB_Shortcut_Control)
		RemoveKeyboardShortcut(#Window,#PB_Shortcut_P|#PB_Shortcut_Control)
		RemoveKeyboardShortcut(#Window,#PB_Shortcut_R|#PB_Shortcut_Control)
		RemoveKeyboardShortcut(#Window,#PB_Shortcut_X|#PB_Shortcut_Control)
		RemoveKeyboardShortcut(#Window,#PB_Shortcut_Y|#PB_Shortcut_Control)

		For mode=0 To #MaxFunctions-1
			RemoveKeyboardShortcut(#Window,#PB_Shortcut_1+mode|#PB_Shortcut_Control)
		Next mode

	EndIf

EndProcedure
Procedure Init()

	Protected i

	initeval()

	With Plot
		\DpiScale=DesktopResolutionX()*#PB_DpiScale

		\FncCount=3
		\FncActive=1

		\Top=	66
		\Bottom=	60
		\Border=	25

		\MinX=	-10
		\MaxX=	10

		\MinY=	-7.5
		\MaxY=	7.5

		\AllowErr=1
		\Precision=3
	EndWith

	For i=1 To #MaxFunctions
		With Funct(i)
			\Name="Function #"+Str(i)
			\Visible=	#True
			\Filled=	#True
			\LineWidth=	2
		EndWith
	Next i

	Funct(1)\Formula=	"(x+5)*(x-3)*(x-10)/25.0"
	Funct(2)\Formula=	"Sin(-PI/2/(X+0.2))"
	Funct(3)\Formula=	"1/x"
	Funct(4)\Formula=	"a=4:x*a"
	Funct(5)\Formula=	"(x>0)*sqr(x)"
	Funct(6)\Formula=	"(x<4&x>0)*sqr(x) + (x>=4)*(sin(x-4)/4+2)"

	Funct(1)\Color=	#ColorFn1
	Funct(2)\Color=	#ColorFn2
	Funct(3)\Color=	#ColorFn3
	Funct(4)\Color=	#ColorFn4
	Funct(5)\Color=	#ColorFn5
	Funct(6)\Color=	#ColorFn6

	LoadFont(#Font,"Bahnschrift",14)
	LoadFont(#FontInfo,"Bahnschrift",12)

	OpenWindow(#Window,0,0,800,600,"Function Graph 1.ooo",#PB_Window_SizeGadget|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_ScreenCentered|#PB_Window_Invisible)
	WindowBounds(#Window,400,250,4000,2500)
	CanvasGadget(#Canvas,0,0,WindowWidth(#Window),WindowHeight(#Window))
	TextGadget(#Info,0,0,100,100,"",#SS_CENTERIMAGE)
	SetGadgetFont(#Info,FontID(#FontInfo))
	SetGadgetColor(#Info,#PB_Gadget_BackColor,#ColorBack)
	SetGadgetFont(#PB_Default,FontID(#Font))
	StringGadget(#Edit,0,0,100,100,"")
	HideGadget(#Info,#True)
	HideGadget(#Edit,#True)

	AddKeyboardShortcut(#Window,#PB_Shortcut_Return,#KeyReturn)
	AddKeyboardShortcut(#Window,#PB_Shortcut_Escape,#KeyEscape)

	Shortcuts(#True)

	AddWindowTimer(#Window,0,100)
	BindEvent(#PB_Event_SizeWindow,@DrawCanvas(),#Window)
	HideWindow(#Window,#Null)

EndProcedure
Procedure Edit(mode)

	Protected.i n
	Protected.d a,b
	Protected.s s,t

	With Plot

		If mode<#EditFunction
			If mode=#EditAccept
				s=GetGadgetText(#Edit)
				Select \EditMode
				Case #EditFunction
					Funct(\FncActive)\Formula=s
				Case #EditName
					Funct(\FncActive)\Name=s
				Case #EditLine
					a=ValD(s)
					If a>=0.1 And a<=10
						Funct(\FncActive)\LineWidth=a
					Else
						mode=#EditExit
					EndIf
				Case #EditPrecision
					n=Val(s)
					If n>=0 And n<=10
						\Precision=n
					Else
						mode=#EditExit
					EndIf
				Case #EditRangeX
					a=ValD(StringField(s,1,","))
					b=ValD(StringField(s,2,","))
					If a<b
						\MinX=a
						\MaxX=b
					Else
						mode=#EditExit
					EndIf
				Case #EditRangeY
					a=ValD(StringField(s,1,","))
					b=ValD(StringField(s,2,","))
					If a<b
						\MinY=a
						\MaxY=b
					Else
						mode=#EditExit
					EndIf
				EndSelect
			EndIf

			Shortcuts(#True)
			HideGadget(#Info,#True)
			HideGadget(#Edit,#True)
			SetActiveGadget(#Canvas)
			\EditMode=#EditOff

			If mode=#EditAccept
				DrawCanvas()
			EndIf

		Else
			Select mode
			Case #EditFunction
				s="function '"+Funct(\FncActive)\Name+"'"
				t=Funct(\FncActive)\Formula
			Case #EditName
				s="name of function #"+Str(\FncActive)
				t=Funct(\FncActive)\Name
			Case #EditLine
				s="line width for function '"+Funct(\FncActive)\Name+"'"
				Debug s
				t=StrD(Funct(\FncActive)\LineWidth)
			Case #EditPrecision
				s="drawing precision"
				t=Str(\Precision)
			Case #EditRangeX
				s="range for X values (min,max)"
				t=StrD(\MinX)+","+StrD(\MaxX)
			Case #EditRangeX
				s="range for Y values (min,max)"
				t=StrD(\MinY)+","+StrD(\MaxY)
			EndSelect

			Shortcuts(#Null)
			SetGadgetText(#Info,"  Edit "+s+":")
			SetGadgetText(#Edit,t)
			HideGadget(#Info,#Null)
			HideGadget(#Edit,#Null)
			SetActiveGadget(#Edit)
			\EditMode=mode

		EndIf

	EndWith

EndProcedure
Procedure Main()

	Protected.i event
	Protected.i lock
	Protected.i x,y
	Protected.d d

	Init()

	With Plot
		Repeat
			Select WaitWindowEvent()
			Case #PB_Event_Gadget,#PB_Event_Menu
				event=EventGadget()
				Select event
				Case #KeyScrollDown
					d=GridSize(\RangeY/12)
					\MinY-d
					\MaxY-d
					DrawCanvas()

				Case #KeyScrollUp
					d=GridSize(\RangeY/12)
					\MinY+d
					\MaxY+d
					DrawCanvas()

				Case #KeyScrollRight
					d=GridSize(\RangeX/12)
					\MinX+d
					\MaxX+d
					DrawCanvas()

				Case #KeyScrollLeft
					d=GridSize(\RangeX/12)
					\MinX-d
					\MaxX-d
					DrawCanvas()

				Case #KeyZoomIn
					d=\RangeX/4
					\MinX+d
					\MaxX-d
					\RangeX/2
					d=\RangeY/4
					\MinY+d
					\MaxY-d
					\RangeY/2
					DrawCanvas()

				Case #KeyZoomOut
					d=\RangeX/2
					\MinX-d
					\MaxX+d
					\RangeX*2
					d=\RangeY/2
					\MinY-d
					\MaxY+d
					\RangeY*2
					DrawCanvas()

				Case #KeyCopyClipboard
					CopyCanvas()

				Case #KeyTab
					If \FncCount>1
						\FncActive=(\FncActive%\FncCount)+1
						DrawCursor(#True)
					EndIf
				Case #KeyTabShift
					If \FncCount>1
						\FncActive=((\FncActive+\FncCount-2)%\FncCount)+1
						DrawCursor(#True)
					EndIf

				Case #KeySpace
					Funct(\FncActive)\Filled!1
					DrawCanvas()

				Case #KeyOuterSpace
					Funct(\FncActive)\Visible!1
					DrawCanvas()

				Case #KeyReturn
					If \EditMode
						Edit(#EditAccept)
					Else
						Edit(#EditFunction)
					EndIf

				Case #KeyEscape
					If \EditMode
						Shortcuts(#True)
						HideGadget(#Info,#True)
						HideGadget(#Edit,#True)
						SetActiveGadget(#Canvas)
						\EditMode=#Null
					EndIf

				Case #Canvas
					event=EventType()
					Select event
					Case #PB_EventType_LeftClick,#PB_EventType_LeftDoubleClick
						If \EditMode
							If event=#PB_EventType_LeftClick And lock=0
								PostEvent(#PB_Event_Gadget,#Window,#KeyReturn)
							EndIf
						Else
							x=GetGadgetAttribute(#Canvas,#PB_Canvas_MouseX)
							y=GetGadgetAttribute(#Canvas,#PB_Canvas_MouseY)
							If y>\Height-\Bottom And x>\Border And x<\Width-\Border
								x-\Border
								x=x/((\Width-\Border*2)/\FncCount)+1
								If x<>\FncActive
									\FncActive=x
									DrawCursor(#True)
								EndIf
								If event=#PB_EventType_LeftDoubleClick
									lock=5
									PostEvent(#PB_Event_Gadget,#Window,#KeyReturn)
								EndIf
							EndIf
						EndIf

					EndSelect

				Case #KeyEditName
					Edit(#EditName)
				Case #KeyEditLine
					Edit(#EditLine)
				Case #KeyEditPrecision
					Edit(#EditPrecision)
				Case #KeyEditRangeX
					Edit(#EditRangeX)
				Case #KeyEditRangeY
					Edit(#EditRangeY)

				Case #KeyNewFunction
					If \FncCount<#MaxFunctions
						\FncCount+1
						DrawCanvas()
					EndIf

				Case #KeyDelFunction
					If \FncCount>1
						\FncCount-1
						If \FncActive>\FncCount : \FncActive-1 : EndIf
						DrawCanvas()
					EndIf

				Case #KeyControl1 To #KeyControl6
					event-#KeyControl1+1
					If event<=\FncCount
						\FncActive=event
						DrawCanvas()
					EndIf

				EndSelect

			Case #PB_Event_Timer
				If lock
					lock-1
				EndIf

			Case #PB_Event_CloseWindow
				If \EditMode
					Edit(#EditExit)
				Else
					Break
				EndIf

			EndSelect
		ForEver
	EndWith

EndProcedure
Main()

[Shardik]

...should be DPI aware and there's also a small hope could work on Linux and Mac computers.

Nope. These Windows API functions don't work on Linux and MacOS:

• GetDeviceCaps_()
• GetDC_()
• SendMessage_()

[Michael Vogel]

...should be DPI aware and there's also a small hope could work on Linux and Mac computers.

Nope. These Windows API functions don't work on Linux and MacOS:

• GetDeviceCaps_()
• GetDC_()
• SendMessage_()

As said, a *** small hope *** - but I can't believe that this two simple lines are the only things not working (that would be to easy):
* the first line had a universal alternative on top of the code - now I removed the criticized line
* the second line was for selecting the text - removed this one as well

[WilliamL]

..on Mac changed

Code: Select all

TextGadget(#Info,0,0,100,100,"",#SS_CENTERIMAGE)

to

Code: Select all

TextGadget(#Info,0,0,100,100,"") ; ,#SS_CENTERIMAGE)

and it works! But does nothing. Maybe I need a hint how to use it.

[infratec]

Have you tested the code with PB 6.20 beta 2?

In my case the window stays empty and the program is blocking.

[skywalk]

Yes, PB v620b2 fails if ASM, but C works fine.

[infratec]

The problem is 1/x

This function is never shown and leads to an endless loop in asm.

The problem is x = 0

Produce error:

Code: Select all

Funct(3)\Formula=	"1/x"

Works:

Code: Select all

Funct(3)\Formula=	"1/1"

[infratec]

I tried something like:

Code: Select all

If EvalError = #EvalErrorDivisionByZero
  Node()\Y = Plot\MaxY * 100
EndIf

in the CalcFunction()

Since EvalError = #EvalErrorDivisionByZero was never checked,
but also an additional check at the tuning part results in a wrong drawing,

[PeDe]

Windows 7 x64 with PB v6.20b2

x86/x64 Asm and C backend work.

But I have to activate the compiler option 'Enable DPI aware executable', otherwise there is an endless loop at startup.
I am using 125% screen scaling.

Peter

[infratec]

Code: Select all

777: If EvalError = #EvalErrorDivisionByZero
		  If Node()\X < 0.1
		    Node()\Y = Plot\MaxY * -100
		  Else
		    Node()\Y = Plot\MaxY * 100
		  EndIf
    EndIf

And

Code: Select all

If tuning And Abs((*P1\Y+*P3\Y-2*P2\Y)) > Resolution/Abs(*P1\X-*P3\X) And Abs(*P3\Y) <> Plot\MaxY * 100

Is nearly correct, but ... one node needs to be deleted.

[SMaag]

Yes it's the "1/x", samie problem at 6.12 x64 ASM, works with C-Backend.
But I could not find a solution for. I guess it's at 1/0 calculation.

[Michael Vogel]

Interesting observations, I wrote the program for Windows 11 with PB6.04, no crash/endless loop are seen with/without DPI aware flag. I checked the program also with PB6.12 without any problems.

So if any specific function seems to make troubles, reduce the focus to this single function:

Code: Select all

Procedure Init()
	;
	\FncCount=    1; !!! Show only first function
	;
	\AllowErr=	#EvalErrorDivisionByZero
	\Precision=	1
	;	
	Funct(1)\Formula=	"1/0"
	;

Anyhow there are some small issues whith the error handling which tries to decide if a function is shown or not. So this does not has a great impact but should be corrected anyway.

Therefore the procedure 'eval' should be changed a little bit:

Code: Select all

	Procedure.d eval(str.s,xval.d,*error.Integer=#Null)
		
		Protected val.d
		
		; X
		EvalVarVal(0)=xval

		;entry point into parser
		EvalStep=1
		EvalError=#EvalNoError
		EvalExpression=UCase(str)
		gettoken()
		If EvalToken=""
			EvalError=#EvalErrorNoExpression
		EndIf

		isErr(EvalExpression)
		
		val=level1()
		
		If EvalError
			If *error
				*error\i=EvalError
			EndIf
			ProcedureReturn #Null
		EndIf

		ProcedureReturn val

	EndProcedure

All eval calls in procedures with the local variable 'error' should be changed to use this variable instead of EvalError like in the following example:

Code: Select all

Node()\Y=eval(Fns(m),Node()\X,@Error); instead of Node()\Y=eval(Fns(m),Node()\X,@EvalError)

Finally within the procedure DrawFunction the error condition needs to be changed to...

Code: Select all

If Error<=Plot\AllowErr

[STARGÅTE]

Nice example.

However, since I program such things myself, I like to discover errors in the parsing

• -x^2 is parsed as (-x)^2 instead of -(x^2)
• Sequenced power operator is ignored: e^x^2 is parsed as e^x instead of e^(x^2)
• In procedure primitive() you parse a float with ValF() instead a double with ValD()

Further, all function with undefined points or regions are not plotted at all, like 1/x, Log(x), ...

[Michael Vogel]

Thanks Stargate for these valuable hints, maybe you'll help to solve some of the problems

ValF is an easy one, lets see how to fix the other points...

Concerning 1/x and so on...
...I do see the 1/x and other graphs here (PB6.04) but not the log function because the vector library does not accept ectreme high/low values. So a quick hack in DrawFunction will change that (anyhow there's something wrong as Y will be +Infinity for X=0 instead of -Infinity) then...

Code: Select all

			Y=PY(Node()\Y)
			If y>1e9
				y=1e9
			ElseIf y<-1e9
				y=-1e9
			EndIf

[Little John]

Hello Michael,

I didn't look at your code in detail. However, the output looks nice.

[...], lets see how to fix the other points...

Please feel free to use this math parser in your code. It handles all basic math expressions correctly, including those mentioned above by Stargate.