- Welcome to Interactive PowerBasic Forum.
Your resource for programming with PowerBASIC™
Recent posts
#1
Contentious discussions about anything, the world, politics and health topics. / Alien Agenda: Into the Future
Last post by Charles Pegge - Today at 12:24:23 AMQuality production. Good coverage of the subject.
Best Documentary
14 apr 2024
Best Documentary
14 apr 2024
#2
Source Code and Discussions / "IsLike" Patternmatcher in 2 V...
Last post by Theo Gottwald - Yesterday at 01:39:53 PMOriginal "IsLike" Function.
The provided PowerBasic function, Is_Like, is designed to check if a given string (a) matches a pattern defined in another string (b). The function supports several wildcard characters for pattern matching, such as *, ?, #, and character ranges using [ and ]. The lCase parameter determines whether the comparison should be case-sensitive or not.
While the function appears to be well-written and covers most of the edge cases, there are a few minor issues that need to be addressed:
In the case of the # wildcard, the function only checks for numeric digits (0-9). However, the # wildcard is typically used to match any single character, not just digits. If you want to match any single character, you should change the range from (48-57) to (32-126) or any other desired range.
In the case of the [ wildcard, the function does not handle the situation where the closing bracket ] is the first character after the opening bracket. For example, the pattern [abc] would not be handled correctly. To fix this, you should add a check for the closing bracket as the first character and treat it as a literal character to match.
The function does not handle escaped wildcard characters properly. For example, if you want to match a literal * or ? in the pattern, the function does not provide a way to escape these characters. You may want to consider adding support for escaping wildcard characters using a backslash \ or another appropriate escape character.
Once these issues are addressed, the function should work as expected for most cases. However, it is always a good idea to thoroughly test the function with various input strings and patterns to ensure it behaves correctly.
Here's an improved version of the Is_Like function that addresses the issues mentioned earlier:
The ? wildcard now matches any single character.
The # wildcard now matches just numeric digits.
The [ wildcard now handles the closing bracket ] as the first character after the opening bracket.
The function now supports escaping wildcard characters using a backslash \.
Here's the updated PowerBasic function:
This updated function should handle the mentioned issues and provide better wildcard pattern matching.
The provided PowerBasic function, Is_Like, is designed to check if a given string (a) matches a pattern defined in another string (b). The function supports several wildcard characters for pattern matching, such as *, ?, #, and character ranges using [ and ]. The lCase parameter determines whether the comparison should be case-sensitive or not.
While the function appears to be well-written and covers most of the edge cases, there are a few minor issues that need to be addressed:
In the case of the # wildcard, the function only checks for numeric digits (0-9). However, the # wildcard is typically used to match any single character, not just digits. If you want to match any single character, you should change the range from (48-57) to (32-126) or any other desired range.
In the case of the [ wildcard, the function does not handle the situation where the closing bracket ] is the first character after the opening bracket. For example, the pattern [abc] would not be handled correctly. To fix this, you should add a check for the closing bracket as the first character and treat it as a literal character to match.
The function does not handle escaped wildcard characters properly. For example, if you want to match a literal * or ? in the pattern, the function does not provide a way to escape these characters. You may want to consider adding support for escaping wildcard characters using a backslash \ or another appropriate escape character.
Once these issues are addressed, the function should work as expected for most cases. However, it is always a good idea to thoroughly test the function with various input strings and patterns to ensure it behaves correctly.
Code Select
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
Here's an improved version of the Is_Like function that addresses the issues mentioned earlier:
The ? wildcard now matches any single character.
The # wildcard now matches just numeric digits.
The [ wildcard now handles the closing bracket ] as the first character after the opening bracket.
The function now supports escaping wildcard characters using a backslash \.
Here's the updated PowerBasic function:
Code Select
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
This updated function should handle the mentioned issues and provide better wildcard pattern matching.
#3
AI / ChatGPT / Stable DIffusion / AGI / 2 Types of neurons for a neura...
Last post by Theo Gottwald - April 13, 2024, 03:16:04 PMYou can implement different types of neurons for a neural network using assembly or similar low-level code. However, it's important to note that assembly code is not typically used for implementing neural networks due to its complexity and lack of readability. High-level languages like Python, with libraries such as TensorFlow or PyTorch, are more commonly used for this purpose.
That being said, here's an example of a simple ReLU (Rectified Linear Unit) neuron and a sigmoid neuron using the fastest available floating-point data type (EXTENDED) in assembly-like code. Note that this is a simplified example and does not include any optimizations or additional features that would be needed for a real-world neural network implementation.
**ReLU Neuron:**
**Sigmoid Neuron:**
Backpropagation
**Backpropagation in Assembly-like Code for ReLU and Sigmoid Neurons**
**🚀 Forward Pass:**
1. **Calculate Outputs:** Sequentially compute and store the output for each neuron from input to output layers.
**🎯 Output Layer Error Calculation:**
1. **Compute Error:** Use mean squared error (MSE) for each neuron by \( \frac{{(\text{expected value} - \text{output value})^2}}{2} \).
**⏪ Backward Pass:**
1. **Error Propagation:** Using errors from subsequent layers, compute errors for the previous layers.
2. **Activation Derivatives:**
- **ReLU:** Derivative is 1 if input > 0; otherwise, it's 0.
- **Sigmoid:** Derivative is output * (1 - output).
3. **Gradient Calculation:** Multiply error by the derivative to get the gradient.
**🔧 Weight Update:**
1. **Adjust Weights:** Apply updates using SGD; \( \text{weight} = \text{weight} - \text{learning rate} \times \text{gradient} \).
**Example for a ReLU Neuron Backward Pass and Weight Update:**
This is just a simplified example demonstrates the process for managing backpropagation for ReLU neurons using assembly-like pseudocode.
Following is real code.
That being said, here's an example of a simple ReLU (Rectified Linear Unit) neuron and a sigmoid neuron using the fastest available floating-point data type (EXTENDED) in assembly-like code. Note that this is a simplified example and does not include any optimizations or additional features that would be needed for a real-world neural network implementation.
**ReLU Neuron:**
Code Select
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
**Sigmoid Neuron:**
Code Select
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 = outputBackpropagation
**Backpropagation in Assembly-like Code for ReLU and Sigmoid Neurons**
**🚀 Forward Pass:**
1. **Calculate Outputs:** Sequentially compute and store the output for each neuron from input to output layers.
**🎯 Output Layer Error Calculation:**
1. **Compute Error:** Use mean squared error (MSE) for each neuron by \( \frac{{(\text{expected value} - \text{output value})^2}}{2} \).
**⏪ Backward Pass:**
1. **Error Propagation:** Using errors from subsequent layers, compute errors for the previous layers.
2. **Activation Derivatives:**
- **ReLU:** Derivative is 1 if input > 0; otherwise, it's 0.
- **Sigmoid:** Derivative is output * (1 - output).
3. **Gradient Calculation:** Multiply error by the derivative to get the gradient.
**🔧 Weight Update:**
1. **Adjust Weights:** Apply updates using SGD; \( \text{weight} = \text{weight} - \text{learning rate} \times \text{gradient} \).
**Example for a ReLU Neuron Backward Pass and Weight Update:**
Code Select
; 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
This is just a simplified example demonstrates the process for managing backpropagation for ReLU neurons using assembly-like pseudocode.
Following is real code.
Code Select
'##################################################################################################
'
'##################################################################################################
' 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
#4
Source Code and Discussions / 🌟 IsDiffInRange, IsSumInRange,...
Last post by Theo Gottwald - April 13, 2024, 02:44:56 PM**🌟 IsDiffInRange, IsSumInRange, & IsProductInRange Macros for Various Data Types 🌟**
These samples demonstrate how DOUBLE, SINGLE, and EXTENDED data types can be utilized in x86 ASM to perform operations.
**📋 Overview:**
The **IsProductInRange** macros are designed to check if the product of two numbers (n1 and n2) falls within a specified range (allow). They return a LONG value:
- **1** 🟢: Product is within the range.
- **0** 🔴: Product is outside the range.
**🔧 Macro List:**
- IsProductInRange_Double(n1, n2, allow)
- IsProductInRange_Single(n1, n2, allow)
- IsProductInRange_Extended(n1, n2, allow)
**📐 Parameters:**
- **n1**: First number.
- **n2**: Second number.
- **allow**: Specified range.
**📝 Usage:**
```asm
result = IsProductInRange_Double(n1, n2, allow)
```
Replace `n1`, `n2`, and `allow` with your actual numbers or variables, and `result` with a variable to store the return value.
**💡 Additional Information:**
These macros leverage the x87 FPU for calculations and comparisons, using the FPU stack and flags to determine results. The macros return a LONG value, but can be adapted to return a byte.
Feel free to integrate these in your projects and share your experiences! 🚀
These samples demonstrate how DOUBLE, SINGLE, and EXTENDED data types can be utilized in x86 ASM to perform operations.
**📋 Overview:**
The **IsProductInRange** macros are designed to check if the product of two numbers (n1 and n2) falls within a specified range (allow). They return a LONG value:
- **1** 🟢: Product is within the range.
- **0** 🔴: Product is outside the range.
**🔧 Macro List:**
- IsProductInRange_Double(n1, n2, allow)
- IsProductInRange_Single(n1, n2, allow)
- IsProductInRange_Extended(n1, n2, allow)
**📐 Parameters:**
- **n1**: First number.
- **n2**: Second number.
- **allow**: Specified range.
**📝 Usage:**
```asm
result = IsProductInRange_Double(n1, n2, allow)
```
Replace `n1`, `n2`, and `allow` with your actual numbers or variables, and `result` with a variable to store the return value.
**💡 Additional Information:**
These macros leverage the x87 FPU for calculations and comparisons, using the FPU stack and flags to determine results. The macros return a LONG value, but can be adapted to return a byte.
Feel free to integrate these in your projects and share your experiences! 🚀
Code Select
'------------------------------------------------------------------------------------------------
' 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
'------------------------------------------------------------------------------------------------
#5
OxygenBasic Examples / "Eintopf"-Fractals
Last post by Theo Gottwald - April 13, 2024, 10:09:14 AMWe can add the Barnsley fern fractal to the previous script to create more interesting and complex results. Here's an example program that combines the Koch snowflake fractal, the Sierpinski triangle, and the Barnsley fern fractal:
In this version of the program, we've added the Barnsley fern fractal to the previous script that combined the Koch snowflake fractal and the Sierpinski triangle. The `fern` procedure uses a recursive algorithm to generate the Barnsley fern fractal, with different transformations applied based on a random number.
In the `main` procedure, we first draw the Koch snowflake fractal using the `koch` procedure with different colors for each side of the triangle. We then call the `sierpinski` procedure to create the Sierpinski triangle pattern inside the Koch snowflake, using the same colors as the corresponding sides of the snowflake. Finally, we call the `fern` procedure to create the Barnsley fern fractal at the center of the Sierpinski triangle.
When you run this program, you should see a Koch snowflake fractal with harmonious colors, a Sierpinski triangle pattern inside it, and a Barnsley fern fractal at the center of the Sierpinski triangle. You can experiment with different values of the `level` variable to create different variations of the fractal patterns.
Code Select
' 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();
}
EndScriptIn this version of the program, we've added the Barnsley fern fractal to the previous script that combined the Koch snowflake fractal and the Sierpinski triangle. The `fern` procedure uses a recursive algorithm to generate the Barnsley fern fractal, with different transformations applied based on a random number.
In the `main` procedure, we first draw the Koch snowflake fractal using the `koch` procedure with different colors for each side of the triangle. We then call the `sierpinski` procedure to create the Sierpinski triangle pattern inside the Koch snowflake, using the same colors as the corresponding sides of the snowflake. Finally, we call the `fern` procedure to create the Barnsley fern fractal at the center of the Sierpinski triangle.
When you run this program, you should see a Koch snowflake fractal with harmonious colors, a Sierpinski triangle pattern inside it, and a Barnsley fern fractal at the center of the Sierpinski triangle. You can experiment with different values of the `level` variable to create different variations of the fractal patterns.
#6
OxygenBasic Examples / Combine the Koch snowflake fra...
Last post by Theo Gottwald - April 13, 2024, 10:08:11 AMWe can combine the Koch snowflake fractal with the Sierpinski triangle and add some color to create a more harmonious and visually interesting fractal! Here's an example program that does just that:
In this version of the program, we've combined the Koch snowflake fractal with the Sierpinski triangle and added some color to create a more harmonious and visually interesting fractal. The `koch` procedure is the same as before, but we've added a new `sierpinski` procedure that recursively subdivides a triangle and removes its center to create the Sierpinski triangle pattern.
In the `main` procedure, we first draw the Koch snowflake fractal using the `koch` procedure with different colors for each side of the triangle. We then call the `sierpinski` procedure to create the Sierpinski triangle pattern inside the Koch snowflake, using the same colors as the corresponding sides of the snowflake.
When you run this program, you should see a Koch snowflake fractal with harmonious colors and a Sierpinski triangle pattern inside it. You can experiment with different values of the `level` variable to create different variations of the fractal and the Sierpinski triangle pattern.
Code Select
' 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```In this version of the program, we've combined the Koch snowflake fractal with the Sierpinski triangle and added some color to create a more harmonious and visually interesting fractal. The `koch` procedure is the same as before, but we've added a new `sierpinski` procedure that recursively subdivides a triangle and removes its center to create the Sierpinski triangle pattern.
In the `main` procedure, we first draw the Koch snowflake fractal using the `koch` procedure with different colors for each side of the triangle. We then call the `sierpinski` procedure to create the Sierpinski triangle pattern inside the Koch snowflake, using the same colors as the corresponding sides of the snowflake.
When you run this program, you should see a Koch snowflake fractal with harmonious colors and a Sierpinski triangle pattern inside it. You can experiment with different values of the `level` variable to create different variations of the fractal and the Sierpinski triangle pattern.
#7
OxygenBasic Examples / Uses recursion to draw a Koch ...
Last post by Theo Gottwald - April 13, 2024, 09:45:57 AMHere's an example program that uses recursion to draw a Koch snowflake fractal:
In this program, we define a `drawLine` procedure that takes four arguments specifying the coordinates of the two endpoints of a line, and draws the line using OpenGL. We also define a `koch` procedure that takes the same four arguments as `drawLine`, as well as an additional `level` argument that specifies the level of recursion to use when drawing the Koch snowflake.
The `koch` procedure works by first calculating the length and angle of the line segment, and then dividing the line segment into three equal parts. It then calculates the coordinates of the four vertices of the equilateral triangle that forms the middle part of the Koch snowflake, and recursively calls itself four times to draw smaller Koch snowflakes inside the original line segment, with each smaller snowflake having its vertices at the endpoints of the original line segment and the vertices of the equilateral triangle. The recursion continues until the specified `level` is reached.
When you run this program, you should see a Koch snowflake fractal with the specified level of recursion. You can experiment with different values of `level` to see how they affect the appearance of the fractal. Note that larger values of `level` will result in a more detailed fractal, but will also take longer to draw.
More colorful version:
And, we can definitely improve the Koch snowflake fractal to make it more detailed and colorful! Here's an updated version of the program that uses color interpolation and increases the level of recursion to create a more intricate and visually interesting fractal:
We've also increased the level of recursion to 6 to create a more detailed fractal, and adjusted the initial RGB values to create a more colorful and visually interesting result.
When you run this program, you should see a colorful and intricate Koch snowflake fractal with smooth color gradations between adjacent lines. You can experiment with different initial RGB values and levels of recursion to create different variations of the fractal.
Use Triangle-thinning:
We can combine the Koch snowflake fractal with the triangle thinning algorithm to create a more complex and interesting script! Here's an example program that does just that:
In this version of the program, we've combined the Koch snowflake fractal with the triangle thinning algorithm from the previous example. The `koch` procedure is the same as before, but we've added a new `thinTriangle` procedure that recursively subdivides a triangle and thins its edges based on a threshold value.
In the `main` procedure, we first draw the Koch snowflake fractal using the `koch` procedure, and then call the `thinTriangle` procedure to subdivide and thin the edges of the triangle formed by the three outer vertices of the snowflake.
When you run this program, you should see a Koch snowflake fractal with thin, intricate edges that form a complex pattern inside the triangle. You can experiment with different values of the `level` and `threshold` variables to create different variations of the fractal and the thinning pattern.
Code Select
' 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();
}
EndScriptIn this program, we define a `drawLine` procedure that takes four arguments specifying the coordinates of the two endpoints of a line, and draws the line using OpenGL. We also define a `koch` procedure that takes the same four arguments as `drawLine`, as well as an additional `level` argument that specifies the level of recursion to use when drawing the Koch snowflake.
The `koch` procedure works by first calculating the length and angle of the line segment, and then dividing the line segment into three equal parts. It then calculates the coordinates of the four vertices of the equilateral triangle that forms the middle part of the Koch snowflake, and recursively calls itself four times to draw smaller Koch snowflakes inside the original line segment, with each smaller snowflake having its vertices at the endpoints of the original line segment and the vertices of the equilateral triangle. The recursion continues until the specified `level` is reached.
When you run this program, you should see a Koch snowflake fractal with the specified level of recursion. You can experiment with different values of `level` to see how they affect the appearance of the fractal. Note that larger values of `level` will result in a more detailed fractal, but will also take longer to draw.
More colorful version:
And, we can definitely improve the Koch snowflake fractal to make it more detailed and colorful! Here's an updated version of the program that uses color interpolation and increases the level of recursion to create a more intricate and visually interesting fractal:
Code Select
' 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.We've also increased the level of recursion to 6 to create a more detailed fractal, and adjusted the initial RGB values to create a more colorful and visually interesting result.
When you run this program, you should see a colorful and intricate Koch snowflake fractal with smooth color gradations between adjacent lines. You can experiment with different initial RGB values and levels of recursion to create different variations of the fractal.
Use Triangle-thinning:
We can combine the Koch snowflake fractal with the triangle thinning algorithm to create a more complex and interesting script! Here's an example program that does just that:
Code Select
' 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```In this version of the program, we've combined the Koch snowflake fractal with the triangle thinning algorithm from the previous example. The `koch` procedure is the same as before, but we've added a new `thinTriangle` procedure that recursively subdivides a triangle and thins its edges based on a threshold value.
In the `main` procedure, we first draw the Koch snowflake fractal using the `koch` procedure, and then call the `thinTriangle` procedure to subdivide and thin the edges of the triangle formed by the three outer vertices of the snowflake.
When you run this program, you should see a Koch snowflake fractal with thin, intricate edges that form a complex pattern inside the triangle. You can experiment with different values of the `level` and `threshold` variables to create different variations of the fractal and the thinning pattern.
#8
OxygenBasic Examples / Use recursion to draw a Sierp...
Last post by Theo Gottwald - April 13, 2024, 09:42:46 AMHere's an example program that uses recursion to draw a Sierpinski triangle fractal:
In this program, we define a `drawTriangle` procedure that takes six arguments specifying the coordinates of the three vertices of a triangle, and draws the triangle using OpenGL. We also define a `sierpinski` procedure that takes the same six arguments as `drawTriangle`, as well as an additional `level` argument that specifies the level of recursion to use when drawing the Sierpinski triangle.
The `sierpinski` procedure works by first calculating the coordinates of the midpoints of the three sides of the triangle. It then draws the triangle using `drawTriangle`, and recursively calls itself three times to draw smaller triangles inside the original triangle, with each smaller triangle having its vertices at the midpoints of the sides of the original triangle. The recursion continues until the specified `level` is reached.
When you run this program, you should see a Sierpinski triangle fractal with the specified level of recursion. You can experiment with different values of `level` to see how they affect the appearance of the fractal. Note that larger values of `level` will result in a more detailed fractal, but will also take longer to draw.
Code Select
' 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();
}
EndScriptIn this program, we define a `drawTriangle` procedure that takes six arguments specifying the coordinates of the three vertices of a triangle, and draws the triangle using OpenGL. We also define a `sierpinski` procedure that takes the same six arguments as `drawTriangle`, as well as an additional `level` argument that specifies the level of recursion to use when drawing the Sierpinski triangle.
The `sierpinski` procedure works by first calculating the coordinates of the midpoints of the three sides of the triangle. It then draws the triangle using `drawTriangle`, and recursively calls itself three times to draw smaller triangles inside the original triangle, with each smaller triangle having its vertices at the midpoints of the sides of the original triangle. The recursion continues until the specified `level` is reached.
When you run this program, you should see a Sierpinski triangle fractal with the specified level of recursion. You can experiment with different values of `level` to see how they affect the appearance of the fractal. Note that larger values of `level` will result in a more detailed fractal, but will also take longer to draw.
#9
OxygenBasic Examples / Metropolis-Hastings algorithm...
Last post by Theo Gottwald - April 13, 2024, 09:38:43 AMHere's an updated version of the Metropolis-Hastings algorithm for estimating pi that includes graphics:
In this version, we've added a `drawCircle` procedure that draws a circle with radius `RADIUS` centered at the origin. We've also added code to draw a small red sphere at each accepted point in the `metropolisHastings` procedure.
When you run this program, you should see a circle centered at the origin and a cloud of red points inside the circle. The cloud of points represents the accepted proposals in the Metropolis-Hastings algorithm, and should be roughly uniformly distributed inside the circle. The estimate of pi is calculated as `4.0 * acceptCount / NUM_STEPS`, where `acceptCount` is the number of accepted proposals and `NUM_STEPS` is the total number of steps in the random walk.
You can experiment with different values of `NUM_STEPS` and `PROPOSAL_SD` to see how they affect the accuracy of the estimate and the appearance of the graph. Note that larger values of `NUM_STEPS` will result in a more accurate estimate, but will also take longer to run.
Code Select
' 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();
}
EndScriptIn this version, we've added a `drawCircle` procedure that draws a circle with radius `RADIUS` centered at the origin. We've also added code to draw a small red sphere at each accepted point in the `metropolisHastings` procedure.
When you run this program, you should see a circle centered at the origin and a cloud of red points inside the circle. The cloud of points represents the accepted proposals in the Metropolis-Hastings algorithm, and should be roughly uniformly distributed inside the circle. The estimate of pi is calculated as `4.0 * acceptCount / NUM_STEPS`, where `acceptCount` is the number of accepted proposals and `NUM_STEPS` is the total number of steps in the random walk.
You can experiment with different values of `NUM_STEPS` and `PROPOSAL_SD` to see how they affect the accuracy of the estimate and the appearance of the graph. Note that larger values of `NUM_STEPS` will result in a more accurate estimate, but will also take longer to run.
#10
OxygenBasic Examples / Barnsley fern fractal to gener...
Last post by Theo Gottwald - April 13, 2024, 09:32:30 AMHere's an example program that uses the Barnsley fern fractal to generate a 3D model of a fern leaf. The Barnsley fern is a fractal that is generated using an iterated function system (IFS), which is a set of affine transformations that are applied repeatedly to generate a complex shape.
In this program, we define a `Point` struct to represent a 3D point in space. We also define a `MAX_ITER` constant to control the number of iterations used to generate the fern, and a `MAX_POINTS` constant to limit the number of points stored in memory.
The `applyTransform` procedure takes a `Point` pointer and six coefficients that define an affine transformation, and applies the transformation to the point. The `drawFern` procedure draws lines between adjacent points in the `points` array to create the 3D model of the fern.
The `generateFern` procedure generates the Barnsley fern fractal by repeatedly applying a set of four affine transformations to an initial point, and storing the resulting points in the `points` array. The probability of each transformation being applied is controlled by a random number generator.
Finally, the `main` procedure generates the fern using `generateFern`, and then enters a loop that repeatedly calls `drawFern` to display the 3D model of the fern. The loop continues until the user presses the Escape key.
When you run this program, you should see a 3D model of a fern leaf that is generated using the Barnsley fern fractal. You can experiment with different coefficients and probabilities for the affine transformations to create different variations of the fern.
Code Select
' 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```In this program, we define a `Point` struct to represent a 3D point in space. We also define a `MAX_ITER` constant to control the number of iterations used to generate the fern, and a `MAX_POINTS` constant to limit the number of points stored in memory.
The `applyTransform` procedure takes a `Point` pointer and six coefficients that define an affine transformation, and applies the transformation to the point. The `drawFern` procedure draws lines between adjacent points in the `points` array to create the 3D model of the fern.
The `generateFern` procedure generates the Barnsley fern fractal by repeatedly applying a set of four affine transformations to an initial point, and storing the resulting points in the `points` array. The probability of each transformation being applied is controlled by a random number generator.
Finally, the `main` procedure generates the fern using `generateFern`, and then enters a loop that repeatedly calls `drawFern` to display the 3D model of the fern. The loop continues until the user presses the Escape key.
When you run this program, you should see a 3D model of a fern leaf that is generated using the Barnsley fern fractal. You can experiment with different coefficients and probabilities for the affine transformations to create different variations of the fern.