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
```' Sierpinski Triangle Fractal
' Oxygen Basic, ConsoleG, OpenGL
' frank bruebach, 12-04-2024
#compact
%filename "sierpinski.exe"
'uses RTL64
% Title "Sierpinski Triangle Fractal"
'% WindowStyle WS_OVERLAPPEDWINDOW
'% Animated
'% ScaleUp
% PlaceCentral
% AnchorCentral
% shaders
uses consoleG
BeginScript
procedure drawTriangle(float x1, float y1, float x2, float y2, float x3, float y3) {
glBegin(GL_LINE_LOOP);
glVertex2f(x1, y1);
glVertex2f(x2, y2);
glVertex2f(x3, y3);
glEnd();
}
procedure sierpinski(float x1, float y1, float x2, float y2, float x3, float y3, int level) {
if (level == 0) {
return;
}
float midX1 = (x1 + x2) / 2.0;
float midY1 = (y1 + y2) / 2.0;
float midX2 = (x2 + x3) / 2.0;
float midY2 = (y2 + y3) / 2.0;
float midX3 = (x1 + x3) / 2.0;
float midY3 = (y1 + y3) / 2.0;
drawTriangle(x1, y1, x2, y2, x3, y3);
sierpinski(x1, y1, midX1, midY1, midX3, midY3, level-1);
sierpinski(midX1, midY1, x2, y2, midX2, midY2, level-1);
sierpinski(midX3, midY3, midX2, midY2, x3, y3, 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 = 5;
sierpinski(x1, y1, x2, y2, x3, y3, level);
waitkey();
}
EndScript
' Metropolis-Hastings Algorithm for Pi Estimation with Graphics
' Oxygen Basic, ConsoleG, OpenGL
#compact
%filename "metropolis_pi_graphics.exe"
'uses RTL64
% Title "Metropolis-Hastings Algorithm for Pi Estimation with Graphics"
'% WindowStyle WS_OVERLAPPEDWINDOW
'% Animated
'% ScaleUp
% PlaceCentral
% AnchorCentral
% shaders
uses consoleG
BeginScript
const int NUM_STEPS = 1000000;
const float RADIUS = 1.0;
const float PROPOSAL_SD = 0.1;
int acceptCount = 0;
procedure metropolisHastings() {
float x = 0.0;
float y = 0.0;
float proposalX, proposalY, distSq, proposalDistSq, acceptProb;
for (int i = 0; i < NUM_STEPS; i++) {
// Generate a proposal point
proposalX = x + rndn() * PROPOSAL_SD;
proposalY = y + rndn() * PROPOSAL_SD;
proposalDistSq = proposalX*proposalX + proposalY*proposalY;
// Calculate the acceptance probability
distSq = x*x + y*y;
if (distSq > RADIUS*RADIUS && proposalDistSq <= RADIUS*RADIUS) {
acceptProb = 1.0;
} else if (distSq <= RADIUS*RADIUS && proposalDistSq > RADIUS*RADIUS) {
acceptProb = (RADIUS*RADIUS / proposalDistSq);
} else {
acceptProb = 1.0;
}
// Accept or reject the proposal point
if (rnd < acceptProb) {
x = proposalX;
y = proposalY;
acceptCount++;
}
// Draw the current point
pushstate();
translate(x, y, 0);
scale(0.01, 0.01, 0.01);
color(1, 0, 0);
go sphere();
popstate();
}
}
procedure drawCircle() {
glBegin(GL_LINE_LOOP);
for (int i = 0; i <= 360; i++) {
float angle = i * PI / 180.0;
float x = RADIUS * cos(angle);
float y = RADIUS * sin(angle);
glVertex2f(x, y);
}
glEnd();
}
procedure main() {
cls();
shading();
drawCircle();
metropolisHastings();
print("Pi estimate: ");
println(4.0 * acceptCount / NUM_STEPS);
waitkey();
}
EndScript
' Barnsley Fern Fractal in 3D
' Oxygen Basic, ConsoleG, OpenGL
#compact
%filename "barnsley_fern.exe"
'uses RTL64
% Title "Barnsley Fern Fractal in 3D"
'% WindowStyle WS_OVERLAPPEDWINDOW
'% Animated
'% ScaleUp
% PlaceCentral
% AnchorCentral
% shaders
uses consoleG
BeginScript
const int MAX_ITER = 100000
const int MAX_POINTS = 10000
struct Point {
float x, y, z;
};
Point points[MAX_POINTS];
int numPoints = 0;
procedure applyTransform(Point *p, float a, float b, float c, float d, float e, float f) {
float x = p->x;
float y = p->y;
float z = p->z;
p->x = a*x + b*y + c*z + d;
p->y = e*x + f*y + z + 1;
}
procedure drawFern() {
if (numPoints <= 0) {
return;
}
glBegin(GL_LINES);
for (int i = 0; i < numPoints-1; i++) {
glVertex3f(points[i].x, points[i].y, points[i].z);
glVertex3f(points[i+1].x, points[i+1].y, points[i+1].z);
}
glEnd();
}
procedure generateFern() {
Point p;
p.x = 0;
p.y = 0;
p.z = 0;
for (int i = 0; i < MAX_ITER; i++) {
int transform = int(rnd*100);
if (transform < 1) {
applyTransform(&p, 0, 0, 0, 0, 0, 0.16);
} else if (transform < 8) {
applyTransform(&p, 0.85, 0.04, -0.04, 0, -0.85, 1.6);
} else if (transform < 15) {
applyTransform(&p, 0.2, -0.26, 0.23, 0, 0.22, 1.6);
} else if (transform < 85) {
applyTransform(&p, -0.15, 0.28, 0.26, 0, 0.24, 0.44);
} else {
applyTransform(&p, 0, 0, 0, 0, 0, 1.6);
}
if (numPoints < MAX_POINTS) {
points[numPoints++] = p;
}
}
}
procedure main() {
cls();
shading();
generateFern();
while (not key[KB_ESC]) {
drawFern();
wait(0.01);
}
}
EndScript
```Page created in 0.216 seconds with 15 queries.