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
'------------------------------------------------------------------------------------------------
' Koch Snowflake Fractal with Sierpinski Triangle, Barnsley Fern, and Color
' Oxygen Basic, ConsoleG, OpenGL
#compact
%filename "koch_sierpinski_fern.exe"
'uses RTL64
% Title "Koch Snowflake Fractal with Sierpinski Triangle, Barnsley Fern, and Color"
'% WindowStyle WS_OVERLAPPEDWINDOW
'% Animated
'% ScaleUp
% PlaceCentral
% AnchorCentral
% shaders
uses consoleG
BeginScript
procedure drawLine(float x1, float y1, float x2, float y2, float r, float g, float b) {
color(r, g, b);
glBegin(GL_LINES);
glVertex2f(x1, y1);
glVertex2f(x2, y2);
glEnd();
}
procedure koch(float x1, float y1, float x2, float y2, int level, float r, float g, float b) {
if (level == 0) {
drawLine(x1, y1, x2, y2, r, g, b);
return;
}
float dx = x2 - x1;
float dy = y2 - y1;
float len = sqrt(dx*dx + dy*dy) / 3.0;
float angle = atan2(dy, dx);
float x3 = x1 + len * cos(angle);
float y3 = y1 + len * sin(angle);
float x4 = x3 + len * cos(angle + PI / 3.0);
float y4 = y3 + len * sin(angle + PI / 3.0);
float x5 = x2 - len * cos(angle);
float y5 = y2 - len * sin(angle);
koch(x1, y1, x3, y3, level-1, r, g, b);
koch(x3, y3, x4, y4, level-1, g, b, r);
koch(x4, y4, x5, y5, level-1, b, r, g);
koch(x5, y5, x2, y2, level-1, r, g, b);
if (level == 1) {
drawLine(x3, y3, x4, y4, g, b, r);
drawLine(x4, y4, x5, y5, b, r, g);
drawLine(x5, y5, x3, y3, r, g, b);
}
}
procedure sierpinski(float x1, float y1, float x2, float y2, float x3, float y3, int level, float r, float g, float b) {
if (level == 0) {
return;
}
float midX1 = x1 + 0.5 * (x2 - x1);
float midY1 = y1 + 0.5 * (y2 - y1);
float midX2 = x2 + 0.5 * (x3 - x2);
float midY2 = y2 + 0.5 * (y3 - y2);
float midX3 = x3 + 0.5 * (x1 - x3);
float midY3 = y3 + 0.5 * (y1 - y3);
sierpinski(x1, y1, midX1, midY1, midX3, midY3, level-1, r, g, b);
sierpinski(x2, y2, midX2, midY2, midX1, midY1, level-1, g, b, r);
sierpinski(x3, y3, midX3, midY3, midX2, midY2, level-1, b, r, g);
if (level == 1) {
drawLine(midX1, midY1, midX2, midY2, g, b, r);
drawLine(midX2, midY2, midX3, midY3, b, r, g);
drawLine(midX3, midY3, midX1, midY1, r, g, b);
}
}
procedure fern(float x, float y, float a, float b, float c, float d) {
float x1 = 0;
float y1 = 0;
float x2 = 0;
float y2 = 0;
float r = rnd();
if (r < 0.01) {
x1 = 0;
y1 = 0.16 * y;
} else if (r < 0.85) {
x1 = a * x + b * y;
y1 = c * x + d * y + 1.6;
} else if (r < 0.92) {
x1 = a * x - b * y;
y1 = -c * x - d * y + 1.6;
} else {
x1 = 0;
y1 = 0.85 * y;
}
x2 = x + x1;
y2 = y + y1;
drawLine(x, y, x2, y2, 0.0, 0.5, 0.0);
fern(x2, y2, a, b, c, d);
}
procedure main() {
cls();
shading();
float x1 = -0.5;
float y1 = -0.5;
float x2 = 0.5;
float y2 = -0.5;
float x3 = 0.0;
float y3 = 0.5;
int level = 4;
koch(x1, y1, x2, y2, level, 1.0, 0.0, 0.0);
koch(x2, y2, x3, y3, level, 0.0, 1.0, 0.0);
koch(x3, y3, x1, y1, level, 0.0, 0.0, 1.0);
sierpinski(x1, y1, x2, y2, x3, y3, level, 1.0, 0.0, 0.0);
float a = 0.85;
float b = 0.04;
float c = -0.04;
float d = 0.85;
fern(0.0, 0.0, a, b, c, d);
waitkey();
}
EndScript
' Koch Snowflake Fractal with Sierpinski Triangle and Color
' Oxygen Basic, ConsoleG, OpenGL
' frank bruebach, 12-04-2024
#compact
%filename "koch_sierpinski.exe"
'uses RTL64
% Title "Koch Snowflake Fractal with Sierpinski Triangle and Color"
'% WindowStyle WS_OVERLAPPEDWINDOW
'% Animated
'% ScaleUp
% PlaceCentral
% AnchorCentral
% shaders
uses consoleG
BeginScript
procedure drawLine(float x1, float y1, float x2, float y2, float r, float g, float b) {
color(r, g, b);
glBegin(GL_LINES);
glVertex2f(x1, y1);
glVertex2f(x2, y2);
glEnd();
}
procedure koch(float x1, float y1, float x2, float y2, int level, float r, float g, float b) {
if (level == 0) {
drawLine(x1, y1, x2, y2, r, g, b);
return;
}
float dx = x2 - x1;
float dy = y2 - y1;
float len = sqrt(dx*dx + dy*dy) / 3.0;
float angle = atan2(dy, dx);
float x3 = x1 + len * cos(angle);
float y3 = y1 + len * sin(angle);
float x4 = x3 + len * cos(angle + PI / 3.0);
float y4 = y3 + len * sin(angle + PI / 3.0);
float x5 = x2 - len * cos(angle);
float y5 = y2 - len * sin(angle);
koch(x1, y1, x3, y3, level-1, r, g, b);
koch(x3, y3, x4, y4, level-1, g, b, r);
koch(x4, y4, x5, y5, level-1, b, r, g);
koch(x5, y5, x2, y2, level-1, r, g, b);
if (level == 1) {
drawLine(x3, y3, x4, y4, g, b, r);
drawLine(x4, y4, x5, y5, b, r, g);
drawLine(x5, y5, x3, y3, r, g, b);
}
}
procedure sierpinski(float x1, float y1, float x2, float y2, float x3, float y3, int level, float r, float g, float b) {
if (level == 0) {
return;
}
float midX1 = x1 + 0.5 * (x2 - x1);
float midY1 = y1 + 0.5 * (y2 - y1);
float midX2 = x2 + 0.5 * (x3 - x2);
float midY2 = y2 + 0.5 * (y3 - y2);
float midX3 = x3 + 0.5 * (x1 - x3);
float midY3 = y3 + 0.5 * (y1 - y3);
sierpinski(x1, y1, midX1, midY1, midX3, midY3, level-1, r, g, b);
sierpinski(x2, y2, midX2, midY2, midX1, midY1, level-1, g, b, r);
sierpinski(x3, y3, midX3, midY3, midX2, midY2, level-1, b, r, g);
if (level == 1) {
drawLine(midX1, midY1, midX2, midY2, g, b, r);
drawLine(midX2, midY2, midX3, midY3, b, r, g);
drawLine(midX3, midY3, midX1, midY1, r, g, b);
}
}
procedure main() {
cls();
shading();
float x1 = -0.5;
float y1 = -0.5;
float x2 = 0.5;
float y2 = -0.5;
float x3 = 0.0;
float y3 = 0.5;
int level = 4;
koch(x1, y1, x2, y2, level, 1.0, 0.0, 0.0);
koch(x2, y2, x3, y3, level, 0.0, 1.0, 0.0);
koch(x3, y3, x1, y1, level, 0.0, 0.0, 1.0);
sierpinski(x1, y1, x2, y2, x3, y3, level, 1.0, 0.0, 0.0);
waitkey();
}
EndScript
```' Koch Snowflake Fractal
' Oxygen Basic, ConsoleG, OpenGL
#compact
%filename "koch.exe"
'uses RTL64
% Title "Koch Snowflake Fractal"
'% WindowStyle WS_OVERLAPPEDWINDOW
'% Animated
'% ScaleUp
% PlaceCentral
% AnchorCentral
% shaders
uses consoleG
BeginScript
procedure drawLine(float x1, float y1, float x2, float y2) {
glBegin(GL_LINES);
glVertex2f(x1, y1);
glVertex2f(x2, y2);
glEnd();
}
procedure koch(float x1, float y1, float x2, float y2, int level) {
if (level == 0) {
drawLine(x1, y1, x2, y2);
return;
}
float dx = x2 - x1;
float dy = y2 - y1;
float len = sqrt(dx*dx + dy*dy) / 3.0;
float angle = atan2(dy, dx);
float x3 = x1 + len * cos(angle);
float y3 = y1 + len * sin(angle);
float x4 = x3 + len * cos(angle + PI / 3.0);
float y4 = y3 + len * sin(angle + PI / 3.0);
float x5 = x2 - len * cos(angle);
float y5 = y2 - len * sin(angle);
koch(x1, y1, x3, y3, level-1);
koch(x3, y3, x4, y4, level-1);
koch(x4, y4, x5, y5, level-1);
koch(x5, y5, x2, y2, level-1);
}
procedure main() {
cls();
shading();
float x1 = -0.5;
float y1 = -0.5;
float x2 = 0.5;
float y2 = -0.5;
float x3 = 0.0;
float y3 = 0.5;
int level = 4;
koch(x1, y1, x2, y2, level);
koch(x2, y2, x3, y3, level);
koch(x3, y3, x1, y1, level);
waitkey();
}
EndScript
' Koch Snowflake Fractal with Color Interpolation
' Oxygen Basic, ConsoleG, OpenGL
#compact
%filename "koch_color.exe"
'uses RTL64
% Title "Koch Snowflake Fractal with Color Interpolation"
'% WindowStyle WS_OVERLAPPEDWINDOW
'% Animated
'% ScaleUp
% PlaceCentral
% AnchorCentral
% shaders
uses consoleG
BeginScript
procedure drawLine(float x1, float y1, float x2, float y2, float r1, float g1, float b1, float r2, float g2, float b2) {
float dx = x2 - x1;
float dy = y2 - y1;
float len = sqrt(dx*dx + dy*dy);
float angle = atan2(dy, dx);
float dx2 = len * cos(angle);
float dy2 = len * sin(angle);
float dr = r2 - r1;
float dg = g2 - g1;
float db = b2 - b1;
glBegin(GL_LINES);
for (int i = 0; i <= 1; i++) {
float x = x1 + i * dx2;
float y = y1 + i * dy2;
float r = r1 + i * dr;
float g = g1 + i * dg;
float b = b1 + i * db;
color(r, g, b);
glVertex2f(x, y);
}
glEnd();
}
procedure koch(float x1, float y1, float x2, float y2, int level, float r1, float g1, float b1, float r2, float g2, float b2) {
if (level == 0) {
drawLine(x1, y1, x2, y2, r1, g1, b1, r2, g2, b2);
return;
}
float dx = x2 - x1;
float dy = y2 - y1;
float len = sqrt(dx*dx + dy*dy) / 3.0;
float angle = atan2(dy, dx);
float x3 = x1 + len * cos(angle);
float y3 = y1 + len * sin(angle);
float x4 = x3 + len * cos(angle + PI / 3.0);
float y4 = y3 + len * sin(angle + PI / 3.0);
float x5 = x2 - len * cos(angle);
float y5 = y2 - len * sin(angle);
float r3 = (r1 + 2 * r2) / 3.0;
float g3 = (g1 + 2 * g2) / 3.0;
float b3 = (b1 + 2 * b2) / 3.0;
float r4 = (2 * r1 + r2) / 3.0;
float g4 = (2 * g1 + g2) / 3.0;
float b4 = (2 * b1 + b2) / 3.0;
koch(x1, y1, x3, y3, level-1, r1, g1, b1, r3, g3, b3);
koch(x3, y3, x4, y4, level-1, r3, g3, b3, r4, g4, b4);
koch(x4, y4, x5, y5, level-1, r4, g4, b4, r2, g2, b2);
koch(x5, y5, x2, y2, level-1, r2, g2, b2, r3, g3, b3);
}
procedure main() {
cls();
shading();
float x1 = -0.5;
float y1 = -0.5;
float x2 = 0.5;
float y2 = -0.5;
float x3 = 0.0;
float y3 = 0.5;
int level = 6;
float r1 = 1.0;
float g1 = 0.0;
float b1 = 0.0;
float r2 = 0.0;
float g2 = 1.0;
float b2 = 0.0;
koch(x1, y1, x2, y2, level, r1, g1, b1, r2, g2, b2);
koch(x2, y2, x3, y3, level, r2, g2, b2, r1, g1, b1);
koch(x3, y3, x1, y1, level, r1, g1, b1, r2, g2, b2);
waitkey();
}
EndScript
```
In this version of the program, we've added color interpolation to the `drawLine` procedure, which now takes six additional arguments specifying the RGB values of the start and end colors of the line. The `koch` procedure has also been updated to take these additional color arguments and interpolate the colors between recursive calls.' Koch Snowflake Fractal with Triangle Thinning
' Oxygen Basic, ConsoleG, OpenGL
' frank bruebach, 12-04-2024
#compact
%filename "koch_triangle.exe"
'uses RTL64
% Title "Koch Snowflake Fractal with Triangle Thinning"
'% WindowStyle WS_OVERLAPPEDWINDOW
'% Animated
'% ScaleUp
% PlaceCentral
% AnchorCentral
% shaders
uses consoleG
BeginScript
procedure drawLine(float x1, float y1, float x2, float y2) {
glBegin(GL_LINES);
glVertex2f(x1, y1);
glVertex2f(x2, y2);
glEnd();
}
procedure koch(float x1, float y1, float x2, float y2, int level) {
if (level == 0) {
drawLine(x1, y1, x2, y2);
return;
}
float dx = x2 - x1;
float dy = y2 - y1;
float len = sqrt(dx*dx + dy*dy) / 3.0;
float angle = atan2(dy, dx);
float x3 = x1 + len * cos(angle);
float y3 = y1 + len * sin(angle);
float x4 = x3 + len * cos(angle + PI / 3.0);
float y4 = y3 + len * sin(angle + PI / 3.0);
float x5 = x2 - len * cos(angle);
float y5 = y2 - len * sin(angle);
koch(x1, y1, x3, y3, level-1);
koch(x3, y3, x4, y4, level-1);
koch(x4, y4, x5, y5, level-1);
koch(x5, y5, x2, y2, level-1);
if (level == 1) {
drawLine(x3, y3, x4, y4);
drawLine(x4, y4, x5, y5);
drawLine(x5, y5, x3, y3);
}
}
procedure thinTriangle(float x1, float y1, float x2, float y2, float x3, float y3, float threshold) {
float dx1 = x2 - x1;
float dy1 = y2 - y1;
float dx2 = x3 - x2;
float dy2 = y3 - y2;
float dx3 = x1 - x3;
float dy3 = y1 - y3;
float len1 = sqrt(dx1*dx1 + dy1*dy1);
float len2 = sqrt(dx2*dx2 + dy2*dy2);
float len3 = sqrt(dx3*dx3 + dy3*dy3);
float midX1 = x1 + 0.5 * dx1;
float midY1 = y1 + 0.5 * dy1;
float midX2 = x2 + 0.5 * dx2;
float midY2 = y2 + 0.5 * dy2;
float midX3 = x3 + 0.5 * dx3;
float midY3 = y3 + 0.5 * dy3;
if (len1 >= threshold && len2 >= threshold && len3 >= threshold) {
drawLine(midX1, midY1, midX2, midY2);
drawLine(midX2, midY2, midX3, midY3);
drawLine(midX3, midY3, midX1, midY1);
thinTriangle(x1, y1, midX1, midY1, midX3, midY3, threshold * 0.5);
thinTriangle(x2, y2, midX2, midY2, midX1, midY1, threshold * 0.5);
thinTriangle(x3, y3, midX3, midY3, midX2, midY2, threshold * 0.5);
}
}
procedure main() {
cls();
shading();
float x1 = -0.5;
float y1 = -0.5;
float x2 = 0.5;
float y2 = -0.5;
float x3 = 0.0;
float y3 = 0.5;
int level = 4;
float threshold = 0.01;
koch(x1, y1, x2, y2, level);
koch(x2, y2, x3, y3, level);
koch(x3, y3, x1, y1, level);
thinTriangle(x1, y1, x2, y2, x3, y3, threshold);
waitkey();
}
EndScript
```Page created in 0.106 seconds with 14 queries.