Quote from: Frank Brübach on Today at 05:31:08 AM' -- opgl test with axis and sin cos curves
'
$ FileName "t.exe"
$ title "Triangle and Axis with sin cos curves"
int width=640
int height=480
uses OpenglSceneFrame
function KeyState(int k) as int
===============================
return GetAsyncKeyState(k) and 0x8000 'key down
end function
sub Initialize(sys hWnd)
'=======================
end sub
'
'--------------------------------------------- //
sub Scene(sys hWnd)
'angle = radians(i) ' what is radians(i) it's rad(i) ?
static single ang1, angi1 = 1
dim i as integer
dim x, y, angle as single
dim radius as single = 2.0
glClearColor 0.3, 0.3, 0.5, 0
glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT
glLoadIdentity
gltranslatef 0.0, 0.0, -6.0 '-4.0
glrotatef ang1, 0.0, 0.0, 1.0
glBegin GL_TRIANGLES
glColor3f 1.0, 0.0, 0.0 : glVertex3f 0.0, 1.0, 0.0
glColor3f 0.0, 1.0, 0.0 : glVertex3f -1.0, -1.0, 0.0
glColor3f 0.0, 0.0, 1.0 : glVertex3f 1.0, -1.0, 0.0
glEnd
' Draw axis
glBegin GL_LINES
glLineWidth 1.0
gltranslatef 0,0,-4 '-1
glscalef 0.01,0.01,0.01
glColor4ub 250,50,0,0 ' X axis color
glVertex2i -500,0
glVertex2i 500,0
glColor4ub 0,0,255,0 ' Y axis color
glVertex2i 0,500
glVertex2i 0,-500
glEnd
' Draw rounded, smooth sine and cosine curves
glLineWidth 2.0
glBegin GL_LINE_STRIP
'--- how I can set a rounded smooth sin cos curve line?
'--------------------- problem zone -------------------------------- //
for i = -45 to 45
'angle = radians(i) 'angle in radians * 180/pi ' pi 3.1415926536
angle = rad(i*180/3.1415) ' ? circle ok but not sin cos curves
'
x = radius * cos(angle)
y = radius * sin(angle)
glColor4ub 255, 200, 0, 0 ' Sine curve color
glVertex2f x, y
x = radius * cos(angle + 1)
y = radius * sin(angle + 1)
glVertex2f x, y
next
'--- how I can set a rounded smooth sin cos curve line?
'--------------------- problem zone -------------------------------- //
glEnd
'
'UPDATE ROTATION ANGLES
'----------------------
'
'if not action then
'print "Key pressed: 0x%x\n^" + KeyState(k)
'end if
'ang1+=angi1
'if ang1>360 then ang1-=360
'
end sub
sub Release(sys hwnd)
'====================
end sub
glLineWidth 2.0
glColor4ub 255, 200, 0, 0 ' Sine curve color
glBegin GL_LINE_STRIP
for i = -360 to 360
angle = i * 3.1415926536 / 180 ' Correct conversion from degrees to radians
glVertex2f i / 360.0 * 2.0 * 3.1415926536, sin(angle) ' Scale x appropriately and calculate y as sine of angle
next
glEnd
This will render a sine wave across a range matching the setup of your scene, scaled to be visible within the given dimensions.' Filename: t.exe
' Title: Triangle and Axis with sin cos curves
' Dimensions
int width = 640
int height = 480
' Uses
uses OpenglSceneFrame
' Function to check key state
function KeyState(int k) as int
return GetAsyncKeyState(k) and 0x8000 ' Key down
end function
' Initialization sub
sub Initialize(sys hWnd)
end sub
' Main scene rendering sub
sub Scene(sys hWnd)
' Variables
static single ang1, angi1 = 1
dim i as integer
dim x, y, angle as single
dim radius as single = 100.0 ' Larger radius for better curve visibility
' Clear the screen and depth buffer
glClearColor 0.3, 0.3, 0.5, 0
glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT
' Reset transformations
glLoadIdentity
gltranslatef 0.0, 0.0, -6.0
' Rotate the whole scene
glrotatef ang1, 0.0, 0.0, 1.0
' Draw a triangle
glBegin GL_TRIANGLES
glColor3f 1.0, 0.0, 0.0: glVertex3f 0.0, 1.0, 0.0
glColor3f 0.0, 1.0, 0.0: glVertex3f -1.0, -1.0, 0.0
glColor3f 0.0, 0.0, 1.0: glVertex3f 1.0, -1.0, 0.0
glEnd
' Draw axes
glBegin GL_LINES
glLineWidth 2.0
glColor4ub 250, 50, 0, 0 ' X axis color
glVertex2i -320, 0
glVertex2i 320, 0
glColor4ub 0, 0, 255, 0 ' Y axis color
glVertex2i 0, 240
glVertex2i 0, -240
glEnd
' Draw sine and cosine curves
glBegin GL_LINE_STRIP
glColor4ub 255, 200, 0, 0 ' Sine curve color
for i = -360 to 360 step 5
angle = i * 3.1415926536 / 180 ' Convert degrees to radians
glVertex2f i, sin(angle) * radius
next
glEnd
glBegin GL_LINE_STRIP
glColor4ub 0, 255, 200, 0 ' Cosine curve color
for i = -360 to 360 step 5
angle = i * 3.1415926536 / 180 ' Convert degrees to radians
glVertex2f i, cos(angle) * radius
next
glEnd
' Update rotation angles if necessary
' ang1 += angi1
' if ang1 > 360 then ang1 -= 360
end sub
' Cleanup resources
sub Release(sys hwnd)
end sub
glLineWidth 2.0
' Drawing sine curve
glColor4ub 255, 200, 0, 0 ' Orange color
glBegin GL_LINE_STRIP
for i = -360 to 360 step 1 ' Increase range and decrease step for smoothness
glVertex2f i * 0.1, sin(i * PI / 180) * 100 ' Convert degrees to radians and scale up
next
glEnd
' Drawing cosine curve
glColor4ub 0, 255, 200, 0 ' Teal color
glBegin GL_LINE_STRIP
for i = -360 to 360 step 1
glVertex2f i * 0.1, cos(i * PI / 180) * 100
next
glEnd
Considerations ' -- opgl test with axis and sin cos curves
'
$ FileName "t.exe"
$ title "Triangle and Axis with sin cos curves"
int width=640
int height=480
uses OpenglSceneFrame
function KeyState(int k) as int
===============================
return GetAsyncKeyState(k) and 0x8000 'key down
end function
sub Initialize(sys hWnd)
'=======================
end sub
'
'--------------------------------------------- //
sub Scene(sys hWnd)
'angle = radians(i) ' what is radians(i) it's rad(i) ?
static single ang1, angi1 = 1
dim i as integer
dim x, y, angle as single
dim radius as single = 2.0
glClearColor 0.3, 0.3, 0.5, 0
glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT
glLoadIdentity
gltranslatef 0.0, 0.0, -6.0 '-4.0
glrotatef ang1, 0.0, 0.0, 1.0
glBegin GL_TRIANGLES
glColor3f 1.0, 0.0, 0.0 : glVertex3f 0.0, 1.0, 0.0
glColor3f 0.0, 1.0, 0.0 : glVertex3f -1.0, -1.0, 0.0
glColor3f 0.0, 0.0, 1.0 : glVertex3f 1.0, -1.0, 0.0
glEnd
' Draw axis
glBegin GL_LINES
glLineWidth 1.0
gltranslatef 0,0,-4 '-1
glscalef 0.01,0.01,0.01
glColor4ub 250,50,0,0 ' X axis color
glVertex2i -500,0
glVertex2i 500,0
glColor4ub 0,0,255,0 ' Y axis color
glVertex2i 0,500
glVertex2i 0,-500
glEnd
' Draw rounded, smooth sine and cosine curves
glLineWidth 2.0
glBegin GL_LINE_STRIP
'--- how I can set a rounded smooth sin cos curve line?
'--------------------- problem zone -------------------------------- //
for i = -45 to 45
'angle = radians(i) 'angle in radians * 180/pi ' pi 3.1415926536
angle = rad(i*180/3.1415) ' ? circle ok but not sin cos curves
'
x = radius * cos(angle)
y = radius * sin(angle)
glColor4ub 255, 200, 0, 0 ' Sine curve color
glVertex2f x, y
x = radius * cos(angle + 1)
y = radius * sin(angle + 1)
glVertex2f x, y
next
'--- how I can set a rounded smooth sin cos curve line?
'--------------------- problem zone -------------------------------- //
glEnd
'
'UPDATE ROTATION ANGLES
'----------------------
'
'if not action then
'print "Key pressed: 0x%x\n^" + KeyState(k)
'end if
'ang1+=angi1
'if ang1>360 then ang1-=360
'
end sub
sub Release(sys hwnd)
'====================
end sub
includepath "$\inc\"
$ FileName "t.exe"
'include "RTL32.inc"
'include "RTL64.inc"
$ title "Triangle and Axis"
int width=640
int height=480
uses OpenglSceneFrame
' uses console
function KeyState(int k) as int
===============================
return GetAsyncKeyState(k) and 0x8000 'key down
end function
sub Initialize(sys hWnd)
'=======================
end sub
'
sub Scene(sys hWnd)
'==================
'
static single ang1,angi1=1
int action,k
'
glClearColor 0.3, 0.3, 0.5, 0
glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT
'
glLoadIdentity
'
'
gltranslatef 0.0, 0.0, -6.0 '-4.0
glrotatef ang1, 0.0, 0.0, 1.0
'
glBegin GL_TRIANGLES
glColor3f 1.0, 0.0, 0.0 : glVertex3f 0.0, 1.0, 0.0
glColor3f 0.0, 1.0, 0.0 : glVertex3f -1.0, -1.0, 0.0
glColor3f 0.0, 0.0, 1.0 : glVertex3f 1.0, -1.0, 0.0
glEnd
' axis --------- //
glBegin GL_LINES
glLineWidth 1.0
'glrotatef ang1, 0,0,1
gltranslatef 0,0,-4 '-1
glscalef 0.01,0.01,0.01
'
'glBegin GL_LINES
glColor4ub 250,50,0,0
'glColor4ub 0,0,0,0
' -- X axis
glVertex2i -500,0
glVertex2i 500,0
'-- Y axis
glVertex2i 0,500
glVertex2i 0,-500
glEnd
'--- how I can set a rounded smooth sin cos curve line?
'
int i
glLineWidth 2.0
glBegin GL_LINES
for i = -45 to 45 step 1 '-25 to 25
glColor4ub 255, 200, 0, 0
glVertex2i i, sin(i)
glVertex2i i+1, sin(i+1)
'glVertex2i i+0.1, sin(i+0.1)
glColor4ub 0, 255, 200, 0
glVertex2i i, cos(i)
glVertex2i i+1, cos(i+1) '0.1
'glVertex2i i+0.1, sin(i+0.1)
next
glEnd
'
'--- how I can set a rounded smooth sin cos curve line?
'
'UPDATE ROTATION ANGLES
'----------------------
'
if not action then
'print "Key pressed: 0x%x\n^" + KeyState(k)
end if
'ang1+=angi1
'if ang1>360 then ang1-=360
'
end sub
sub Release(sys hwnd)
'====================
end sub
' simple class example with data
' by frank bruebach, oxygen, 16-04-2024
'
' Oxygen Class example
'
' how I can make a salary add for john with 500 euros?
'
class Employee
string names2
string depts2
integer salarys2
method constructor(String name1="John", string dept1="Computer Lab", integer salary=2000)
names2 = name1
depts2 = dept1
salarys2 = salary
print "construct!"
End method
method destructor()
===================
'destroy bstrings
del names2
del depts2
del salarys2
print "destruct!"
end method
method act() as string
======================
return names2 ", " depts2 ", " salarys2
end method
end class
new Employee john("John","Computer Lab", 2000)
print john.act
del john
' how I can make a salary add for john with 500 euros?
[
' simple class example2 with data
' by frank bruebach, oxygen, 16-04-2024
'
' Oxygen Class example
'
' how I can make a salary add for john with 500 euros?
'
class Employee
string names2
string depts2
integer salarys2
method constructor(String name1="John", string dept1="Computer Lab", integer salary=2000)
names2 = name1
depts2 = dept1
salarys2 = salary
print "construct!"
End method
method destructor()
===================
'destroy bstrings
del names2
del depts2
del salarys2
print "destruct!"
end method
method act() as string
======================
return names2 ", " depts2 ", " salarys2
end method
method act2() as string
======================
return names2 ", " depts2 ", " salarys2+500
end method
end class
new Employee john("John","Computer Lab", 2000)
print john.act
print john.act2
del john
FUNCTION Is_Like(BYVAL a AS STRING, BYVAL b AS STRING,BYVAL lCase AS LONG) AS LONG
DIM x AS BYTE PTR
DIM y AS BYTE PTR
DIM matc AS LONG
DIM PrevChar AS BYTE
DIM NextChar AS BYTE
IF lCase THEN
a = a + CHR$(0)
b = b + CHR$(0)
ELSE
a = UCASE$(a + CHR$(0))
b = UCASE$(b + CHR$(0))
END IF
x = STRPTR(a)
y = STRPTR(b)
FUNCTION = %FALSE
DO
IF @x = 0 THEN
IF @y = 0 THEN
FUNCTION = %TRUE
END IF
EXIT FUNCTION
END IF
SELECT CASE @y
CASE 0 'NUL pre-mature end
EXIT FUNCTION
CASE 35 '# match a single numeric digit
IF (@x < 48) OR (@x > 57) THEN
EXIT FUNCTION
END IF
CASE 42 '*
INCR y ' next char in expression
DO
IF @x = @y THEN ' do they match?
EXIT DO ' yes exit
ELSEIF @x = 0 THEN ' end of source string?
EXIT DO ' yes exit
END IF
INCR x ' next char in source string
LOOP
IF @x = 0 THEN ' end of source string?
IF @y = 0 THEN ' also end of expression?
FUNCTION = %TRUE
END IF
EXIT FUNCTION
END IF
CASE 63 '? match any single char
' nothing, it's a match
CASE 91 '[
matc = %TRUE ' assume we have to match chars
INCR y ' next char in expression
IF @y = 33 THEN ' ! indicates do not match
matc = %FALSE
INCR y
END IF
DO
IF @y = 93 THEN ' ]
EXIT FUNCTION
ELSEIF @y = 0 THEN ' NUL
EXIT FUNCTION
ELSEIF @y = 45 THEN ' -
DECR y ' move to previous char in expression
PrevChar = @y ' save previous char
y = y + 2 ' move to next char in expression
NextChar = @y ' save next char
DECR y ' restore current char in expression
IF (PrevChar = 91) OR (PrevChar = 33) OR (NextChar = 93) THEN
IF @y = @x THEN
IF matc = %FALSE THEN 'if matching is false, exit
EXIT FUNCTION
ELSE
EXIT DO
END IF
END IF
ELSE
IF (@x >= PrevChar) AND (@x =< NextChar) THEN
IF matc = %FALSE THEN
EXIT FUNCTION
ELSE
EXIT DO
END IF
ELSE
INCR y
END IF
END IF
ELSEIF @y = @x THEN ' do they match?
IF matc = %FALSE THEN 'if matching is false, exit
EXIT FUNCTION
ELSE
EXIT DO
END IF
END IF
INCR y 'next char in expression
LOOP
DO 'find the closing bracket
IF @y = 93 THEN
EXIT DO
ELSEIF @y = 0 THEN
EXIT FUNCTION
END IF
INCR y
LOOP
CASE ELSE
IF @x <> @y THEN
EXIT DO
END IF
END SELECT
INCR x ' next char in source string
INCR y ' next char in expression
LOOP
END FUNCTION
FUNCTION Is_Like(BYVAL a AS STRING, BYVAL b AS STRING, BYVAL lCase AS LONG) AS LONG
DIM x AS BYTE PTR
DIM y AS BYTE PTR
DIM matc AS LONG
DIM PrevChar AS BYTE
DIM NextChar AS BYTE
DIM result AS LONG
IF lCase THEN
a = a + CHR$(0)
b = b + CHR$(0)
ELSE
a = UCASE$(a + CHR$(0))
b = UCASE$(b + CHR$(0))
END IF
x = STRPTR(a)
y = STRPTR(b)
result = %FALSE
DO
IF @x = 0 THEN
IF @y = 0 THEN
result = %TRUE
GOTO ExitFunction
END IF
GOTO ExitFunction
END IF
SELECT CASE @y
CASE 0 'NUL pre-mature end
GOTO ExitFunction
CASE 92 '\ escape character
IF @y + 1 = 0 THEN
GOTO ExitFunction ' invalid escape at the end of the pattern
END IF
y = y + 1
IF @x <> @y THEN
GOTO ExitFunction
END IF
INCR x
INCR y
ITERATE LOOP
CASE 35 '# match a single digit
IF (@x < 48) OR (@x > 57) THEN
GOTO ExitFunction
END IF
CASE 42 '*
INCR y ' next char in expression
DO
IF @x = @y THEN ' do they match?
EXIT DO ' yes exit
ELSEIF @x = 0 THEN ' end of source string?
EXIT DO ' yes exit
END IF
INCR x ' next char in source string
LOOP
IF @x = 0 THEN ' end of source string?
IF @y = 0 THEN ' also end of expression?
result = %TRUE
GOTO ExitFunction
END IF
GOTO ExitFunction
END IF
CASE 63 '? match any single char
IF @x = 0 THEN
GOTO ExitFunction
END IF
CASE 91 '[
matc = %TRUE ' assume we have to match chars
INCR y ' next char in expression
IF @y = 93 THEN ' handle ] as the first character after [
IF @x <> @y THEN
GOTO ExitFunction
END IF
INCR x
INCR y
ITERATE LOOP
ELSEIF @y = 33 THEN ' ! indicates do not match
matc = %FALSE
INCR y
END IF
DO
IF @y = 93 THEN ' ]
INCR y ' Move to the next character after the closing bracket
EXIT DO
ELSEIF @y = 0 THEN ' NUL
GOTO ExitFunction
ELSEIF @y = 45 THEN ' -
DECR y ' move to previous char in expression
PrevChar = @y ' save previous char
y = y + 2 ' move to next char in expression
NextChar = @y ' save next char in expression
DECR y ' restore current char in expression
IF (PrevChar = 91) OR (PrevChar = 33) OR (NextChar = 93) THEN
IF @y = @x THEN
IF matc = %FALSE THEN 'if matching is false, exit
GOTO ExitFunction
ELSE
EXIT DO
END IF
END IF
ELSE
IF (@x >= PrevChar) AND (@x =< NextChar) THEN
IF matc = %FALSE THEN
GOTO ExitFunction
ELSE
EXIT DO
END IF
ELSE
INCR y
END IF
END IF
ELSEIF @y = @x THEN ' do they match?
IF matc = %FALSE THEN 'if matching is false, exit
GOTO ExitFunction
ELSE
EXIT DO
END IF
END IF
INCR y 'next char in expression
LOOP
CASE ELSE
IF @x <> @y THEN
GOTO ExitFunction
END IF
END SELECT
INCR x ' next char in source string
INCR y ' next char in expression
LOOP
ExitFunction:
FUNCTION = result
END FUNCTION
MACRO FUNCTION ReLUNeuron_Extended(input)
MACROTEMP output
DIM output AS EXTENDED
!fld input 'load input value
!fldz 'load 0.0
!fcomip st(1), st(0) 'compare input with 0.0
!fnstsw ax 'store FPU flags in ax
!sahf 'transfer FPU flags to CPU flags
!jb .Lnegative 'jump to .Lnegative if input < 0.0
!fstp output 'store input value as output if input >= 0.0
!jmp .Lend
.Lnegative:
!fstp input 'discard input value
!fldz 'load 0.0
!fstp output 'store 0.0 as output
.Lend:
END MACRO = output
MACRO FUNCTION SigmoidNeuron_Extended(input)
MACROTEMP output
DIM output AS EXTENDED
!fld input 'load input value
!fldl2e 'load log2(e)
!fyl2x 'compute input * log2(e)
!frndint 'round to nearest integer
!f2xm1 'compute 2^(input * log2(e)) - 1
!fld1 'load 1.0
!faddp 'compute 1.0 + (2^(input * log2(e)) - 1)
!fld1 'load 1.0
!fscale 'compute 1.0 / (1.0 + (2^(input * log2(e)) - 1))
!fstp output 'store output value
END MACRO = output
; Assuming eax holds the input to the neuron
; ebx holds the derivative
; ecx holds the error from the next layer
; edx holds the learning rate
cmp eax, 0 ; Check if input is positive
jle .zero_gradient ; Jump if not positive, derivative is zero
mov ebx, 1 ; Set derivative to 1
jmp .continue ; Continue computation
.zero_gradient:
mov ebx, 0 ; Set derivative to zero
.continue:
; Calculate gradient: gradient = error * derivative
mul ebx, ecx ; Multiply error by derivative to get gradient
; Update weight: weight -= learning_rate * gradient
; Assuming esi points to weight
mov eax, [esi] ; Load current weight
sub eax, edx ; Subtract learning rate times gradient from weight
mov [esi], eax ; Store updated weight back
'##################################################################################################
'
'##################################################################################################
' BackpropagateReLUNeuron_Extended(P1, P2, P3, P4)
'
' This macro performs backpropagation for a single ReLU neuron using the provided parameters:
'
' P1 (input, EXTENDED): The input value to the neuron.
' Value range: Any real number.
'
' P2 (error, EXTENDED): The error value for the neuron, calculated based on the output error and the weights from the subsequent layer.
' Value range: Any real number.
'
' P3 (weight, EXTENDED): The weight value for the neuron.
' Value range: Any real number.
' On output, the updated weight value is stored back into this memory location.
'
' P4 (learning_rate, EXTENDED): The learning rate value used for updating the weight.
' Value range: A positive real number, typically between 0.0 and 1.0.
MACRO BackpropagateReLUNeuron_Extended(P1, P2, P3, P4)
MACROTEMP gradient
DIM gradient AS EXTENDED
!fld P1 'load input value
!fldz 'load 0.0
!fcomip st(1), st(0) 'compare input with 0.0
!fnstsw ax 'store FPU flags in ax
!sahf 'transfer FPU flags to CPU flags
!jb .Lnegative 'jump to .Lnegative if input < 0.0
!fld P2 'load error value
!fmul P1 'compute gradient = error * input
!fstp gradient 'store gradient value
!jmp .Lend
.Lnegative:
!fldz 'load 0.0
!fstp gradient 'store gradient value as 0.0
.Lend:
!fld P3 'load weight value
!fld P4 'load learning rate value
!fmul gradient 'compute learning_rate * gradient
!fsubp 'compute weight - learning_rate * gradient
!fstp P3 'store updated weight value
END MACRO
'------------------------------------------------------------------------------------------------
' Only for use with DOUBLE
' Originalname: zSignedInRangeFPU
MACRO FUNCTION IsDiffInRange_Double(n1, n2, allow)
MACROTEMP ret
DIM ret AS LONG
!xor ecx,ecx 'only needed if you need to return a LONG. If you can return a byte then remove this.
!fild n1 'get the first number (Double)
!fisub n2 'subtract the second number
!fabs 'make result positive
!fild allow 'get the range
!fcompp 'compare the positive result with the range and pop both from the FPU stack so stack is now empty
!fstsw ax 'get FPU flags to ax
!sahf '..and from ax into the CPU flags
!setae cl 'set CL conditional on the flags. cl now contains the return value of 1 or 0.
!mov ret,ecx 'return the whole of ecx but could just return cl
ExitNow:
END MACRO = ret
'------------------------------------------------------------------------------------------------
' (n1 AS SINGLE, n2 AS SINGLE, allow AS SINGLE)
MACRO FUNCTION IsDiffInRange_Single(n1, n2,allow)
MACROTEMP ret
DIM ret AS LONG
!xor ecx,ecx 'only needed if you need to return a LONG. If you can return a byte then remove this.
!filds n1 'get the first number (Single)
!fisub n2 'subtract the second number
!fabs 'make result positive
!filds allow 'get the range (Single)
!fcompp 'compare the positive result with the range and pop both from the FPU stack so stack is now empty
!fstsw ax 'get FPU flags to ax
!sahf '..and from ax into the CPU flags
!setae cl 'set CL conditional on the flags. cl now contains the return value of 1 or 0.
!mov ret,ecx 'return the whole of ecx but could just return cl
ExitNow:
END MACRO = ret
'------------------------------------------------------------------------------------------------
' (n1 AS EXTENDED, n2 AS EXTENDED, allow AS EXTENDED)
'
MACRO FUNCTION IsDiffInRange_Extended(n1, n2, allow)
MACROTEMP ret
DIM ret AS LONG
!xor ecx,ecx 'only needed if you need to return a LONG. If you can return a byte then remove this.
!fld n1 'get the first number (Extended)
!fisub n2 'subtract the second number
!fabs 'make result positive
!fld allow 'get the range (Extended)
!fcompp 'compare the positive result with the range and pop both from the FPU stack so stack is now empty
!fstsw ax 'get FPU flags to ax
!sahf '..and from ax into the CPU flags
!setae cl 'set CL conditional on the flags. cl now contains the return value of 1 or 0.
!mov ret,ecx 'return the whole of ecx but could just return cl
ExitNow:
END MACRO = ret
'------------------------------------------------------------------------------------------------
' These macros check if the sum of two numbers (n1 and n2) is within the specified range (allow).
' They return a LONG value, with 1 indicating that the sum is within the specified range, and 0 indicating that the sum is outside the specified range.
' (n1 AS DOUBLE, n2 AS DOUBLE, allow AS DOUBLE)
MACRO FUNCTION IsSumInRange_Double(n1, n2,allow)
MACROTEMP ret
DIM ret AS LONG
!xor ecx,ecx 'only needed if you need to return a LONG. If you can return a byte then remove this.
!fild n1 'get the first number
!fiadd n2 'add the second number
!fabs 'make result positive
!fild allow 'get the range
!fcompp 'compare the positive result with the range and pop both from the FPU stack so stack is now empty
!fstsw ax 'get FPU flags to ax
!sahf '..and from ax into the CPU flags
!setae cl 'set CL conditional on the flags. cl now contains the return value of 1 or 0.
!mov ret,ecx 'return the whole of ecx but could just return cl
ExitNow:
END MACRO = ret
'------------------------------------------------------------------------------------------------
' (n1 AS SINGLE, n2 AS SINGLE, allow AS SINGLE)
MACRO FUNCTION IsSumInRange_Single(n1, n2,allow)
MACROTEMP ret
DIM ret AS LONG
!xor ecx,ecx 'only needed if you need to return a LONG. If you can return a byte then remove this.
!filds n1 'get the first number (Single)
!fiadds n2 'add the second number (Single)
!fabs 'make result positive
!filds allow 'get the range (Single)
!fcompp 'compare the positive result with the range and pop both from the FPU stack so stack is now empty
!fstsw ax 'get FPU flags to ax
!sahf '..and from ax into the CPU flags
!setae cl 'set CL conditional on the flags. cl now contains the return value of 1 or 0.
!mov ret,ecx 'return the whole of ecx but could just return cl
ExitNow:
END MACRO = ret
'------------------------------------------------------------------------------------------------
' (n1 AS EXTENDED, n2 AS EXTENDED, allow AS EXTENDED)
MACRO FUNCTION IsSumInRange_Extended(n1, n2,allow)
MACROTEMP ret
DIM ret AS LONG
!xor ecx,ecx 'only needed if you need to return a LONG. If you can return a byte then remove this.
!fld n1 'get the first number (Extended)
!fiadd n2 'add the second number (Extended)
!fabs 'make result positive
!fld allow 'get the range (Extended)
!fcompp 'compare the positive result with the range and pop both from the FPU stack so stack is now empty
!fstsw ax 'get FPU flags to ax
!sahf '..and from ax into the CPU flags
!setae cl 'set CL conditional on the flags. cl now contains the return value of 1 or 0.
!mov ret,ecx 'return the whole of ecx but could just return cl
ExitNow:
END MACRO = ret
'------------------------------------------------------------------------------------------------
' These macros use the x87 FPU (Floating Point Unit) to perform the calculations and comparisons.
' The FPU stack is used to store and manipulate the values, and the FPU flags are used to determine the result of the comparison.
' The macros return a LONG value, but this can be changed to return a byte by removing the
' !xor ecx, ecx line and replacing !mov ret, ecx with !mov ret, cl.
'------------------------------------------------------------------------------------------------
' (n1 AS DOUBLE, n2 AS DOUBLE, allow AS DOUBLE)
MACRO FUNCTION IsProductInRange_Double(n1, n2,allow)
MACROTEMP ret
DIM ret AS LONG
!xor ecx,ecx 'only needed if you need to return a LONG. If you can return a byte then remove this.
!fild n1 'get the first number
!fimul n2 'multiply the first number with the second number
!fabs 'make result positive
!fild allow 'get the range
!fcompp 'compare the positive result with the range and pop both from the FPU stack so stack is now empty
!fstsw ax 'get FPU flags to ax
!sahf '..and from ax into the CPU flags
!setae cl 'set CL conditional on the flags. cl now contains the return value of 1 or 0.
!mov ret,ecx 'return the whole of ecx but could just return cl
ExitNow:
END MACRO = ret
'------------------------------------------------------------------------------------------------
' (n1 AS SINGLE, n2 AS SINGLE, allow AS SINGLE)
MACRO FUNCTION IsProductInRange_Single(n1, n2,allow)
MACROTEMP ret
DIM ret AS LONG
!xor ecx,ecx 'only needed if you need to return a LONG. If you can return a byte then remove this.
!filds n1 'get the first number (Single)
!fimuls n2 'multiply the first number with the second number (Single)
!fabs 'make result positive
!filds allow 'get the range (Single)
!fcompp 'compare the positive result with the range and pop both from the FPU stack so stack is now empty
!fstsw ax 'get FPU flags to ax
!sahf '..and from ax into the CPU flags
!setae cl 'set CL conditional on the flags. cl now contains the return value of 1 or 0.
!mov ret,ecx 'return the whole of ecx but could just return cl
ExitNow:
END MACRO = ret
'------------------------------------------------------------------------------------------------
' (n1 AS EXTENDED, n2 AS EXTENDED, allow AS EXTENDED)
MACRO FUNCTION IsProductInRange_Extended(n1, n2,allow)
MACROTEMP ret
DIM ret AS LONG
!xor ecx,ecx 'only needed if you need to return a LONG. If you can return a byte then remove this.
!fld n1 'get the first number (Extended)
!fimul n2 'multiply the first number with the second number (Extended)
!fabs 'make result positive
!fld allow 'get the range (Extended)
!fcompp 'compare the positive result with the range and pop both from the FPU stack so stack is now empty
!fstsw ax 'get FPU flags to ax
!sahf '..and from ax into the CPU flags
!setae cl 'set CL conditional on the flags. cl now contains the return value of 1 or 0.
!mov ret,ecx 'return the whole of ecx but could just return cl
ExitNow:
END MACRO = ret
'------------------------------------------------------------------------------------------------
Page created in 0.693 seconds with 14 queries.