Interesting development at Syntax Bomb today starting with some code from ChatGPT that kay63 got working in sb and I translated and fixed ever better in QB64:
Code: (Select All)
_Title "sb spiral of chatGPT - fixed by kay63 trans and mod by me, b+ 2023-01-04"
Const xmax = 600, ymax = 600
Dim Shared pi
pi = _Pi
Dim clr As _Unsigned Long
Screen _NewImage(xmax, ymax, 32)
' Set the starting position and radius of the spiral
x = ymax / 2 - .5 * ymax / pi
y = ymax / 2 - .5 * ymax / pi
r = 1
' Set the angle increment for each loop iteration
angle_inc = 5
' Set the maximum radius of the spiral
max_r = ymax / 2
' Set the maximum number of loops
max_loops = ymax
' Set the spiral rotation direction
direction = 1
' Draw the spiral
For i = 1 To max_loops
' Set the color for this loop iteration
'Color i Mod 14
' Draw the spiral segment
Select Case i Mod 3
Case 0: clr = _RGB32(0, 255 * (i / 600), 128 - (i * 127 / 600))
Case 1: clr = _RGB32(0, 100 * i / 600 + 55, 100 * i / 600 + 55)
Case 2: clr = _RGB32(0, 255 * (i / 600), 128 - (i * 127 / 600))
End Select
arc x, y, r, angle_inc * i / 180 * pi, angle_inc * (i + 30) / 180 * pi, clr
' Increase the radius for the next loop iteration
r = r + direction
cnt = cnt + 1
' Check if the radius has reached the maximum
If r > max_r Then
' Reverse the growing of the spiral
direction = -direction
' Reset the radius
r = max_r
End If
' move the spiral:
x = x + 1 / pi
y = y + 1 / pi
_Limit 60
Next
Sleep
Sub arc (x, y, r, raStart, raStop, c As _Unsigned Long) ' this does not check raStart and raStop like arcC does
Dim al, a
'x, y origin, r = radius, c = color
'raStart is first angle clockwise from due East = 0 degrees
' arc will start drawing there and clockwise until raStop angle reached
If raStop < raStart Then
arc x, y, r, raStart, _Pi(2), c
arc x, y, r, 0, raStop, c
Else
' modified to easier way suggested by Steve
'Why was the line method not good? I forgot.
al = _Pi * r * r * (raStop - raStart) / _Pi(2)
For a = raStart To raStop Step 1 / al
PSet (x + r * Cos(a), y + r * Sin(a)), c
Next
End If
End Sub
EDIT: fixed some errors in coloring which surprisingly didn't really change outcome? No it's better now without a bunch of black lines.
In these early days of a new year, I’d like to say thanks to those who’ve helped me and many others with coding problems. People like Steve, and Bplus, and others, with much greater knowledge and skills than I have, give freely of their time to help other “QBphiles” overcome problems. Their help is given with great patience, and with respect for the sometimes “bumpy” code we write, recognizing that although we may peel an egg with a surgical laser, a sharp blow with the back of a spoon can sometimes be sufficient.
Other coders sometimes recognize a problem as being similar to one they have had and solved, and provide helpful advice based on this. This spirit of co-operation and generosity makes me confident that QB64PE will survive and thrive for a long time to come.
Wishing you all a happy, prosperous and productive new year.
Structure and representation of a three-dimensional array. What could one do with it? For example: day, month, total sales . . . Nice!
Oh yes, wrong inputs are not caught yet.
Ebene = level, Zeile = row, Spalte = column
Code: (Select All)
'Dreidimensionales Feld mit graphischer Darstellung - 3. Jan. 2023
$Console:Only
Option _Explicit
Option Base 1
Dim As Integer dreiDimFeld(3, 4, 4)
'"dm" legt die Dimension(Ebenen) fest. Hier dreimal Bloecke a 16
'dz ist Anzahl Zeilen, ds ist Anzahl Spalten
Dim As Integer dm, dz, ds, dFeld
Dim As Integer ebene, zeile, spalte
Locate 2, 2
'Der Ablauf ist: 1te Ebene -> Durchlauf Zeile * Spalte
'dann folgt die naechste Ebene usw. so viele Ebenen
'wie vorhanden sind
dFeld = 1
For dm = 1 To 3
For dz = 1 To 4
'Nach jedem sechszehner Block Absatz
'fuer naechsten Block. Csrlin+1 statt 2 -> schraege Anzeige
Locate CsrLin + 1, CsrLin + 1
For ds = 1 To 4
dreiDimFeld(dm, dz, ds) = dFeld
Print Using "## "; dreiDimFeld(dm, dz, ds),
dFeld = dFeld + 1
Next
Next
Print: Locate , 2
Next
Run the code above and give it a try. You'll see that we start out in a text only screen, so _PixelSize reports 0 back to us -- there's no pixels in a text only screen! There's only columns and rows!
Hit any key and then we swap over to a SCREEN 12 screen. At this point, _PixelSize will report a value of 1 back to us. Each pixel on the screen takes up one byte of memory.
Hit another key and we swap over to a 32-bit screen. Now _PixelSize reports a value of 4 back to us. This is what everyone should expect as 32-bit screens are, by definition, 32-bits -- or 4-bytes -- in size. Each pixel has a single byte dedicated for Alpha, Red, Green, Blue color values, in a 32-bit screen.
... Which is all well and good, but not really all that useful in a single program. If you create your screens, you'll probably know what they are to begin with, and there's no need to use _PixelSize to get that value for you...
... Which is why I mentioned this is a gem of a command for anyone who works on making library style code. You never know when, who, or where your library routine might end up being called, and as such, you'll want to write it to work across various screen modes. (Or to at least trouble shoot and error check against certain screen modes.)
For example, let's say I write a PerfectBox routine which draws a lovely graphical box, puts a texture on the background for it, and a label, and it interacts with the mouse, and plays music when it's on the screen and highlighted, and does your taxes for you, and convinces your significant other to look the other way while you make out with the sexy neighbor down the hall or across the road...
If I wrote such an amazing piece of code, I'd probably want to write it up as a library function and save it for use in all my programs. Right? Heck, I'd probably even want to share it with all you guys so I could brag to the world (well, the world of QB64PE anyway) about what I'd accomplished, and let all of you bask in its glory as well!
And then old @Pete comes along and starts griping... "None of my programs work now, thanks to your stupid PerfectLibrary button!!"
So how do I fix that??
Code: (Select All)
Sub PerfectButton (Parameters As HiddenByTrademark)
If _PixelSize = 0 Then
Print "Pete, this doesn't work in Screen 0! It's a graphical button!"
DeletePetesHardDrive
LaughAtPete
System
End If
....
'Rest of my PerfectButton Sub goes below here.
End Sub
Now, as you can see, we've error trapped for anyone using Screen 0 with our perfect button. Pete can now insert our PerfectButton routine into all his code, and not get generic error messages about invalid syntax and such when he attempts to run his code...
... Let's just hope nobody except Pete happens to try and use our PerfectButton routine on a text Screen... Our error handler may be a little more intense than most people approve of, in the example above...
On Terry Ritchie's function/subroutine part of the QB64 tutorial, line 15 of subs.base, we have:
Code: (Select All)
WHILE _MOUSEINPUT: WEND
The only way I've seen "WHILE" and "WEND" used is at the start and end of a loop, with some instructions in between, which then ends with 'WEND".
I'm confused on what is exactly going on here. Can anyone explain like I'm a five year old?
Code: (Select All)
DO
_LIMIT 60
WHILE _MOUSEINPUT: WEND
IF _MOUSEBUTTON(1) THEN DrawStar _MOUSEX, _MOUSEY
IF _MOUSEBUTTON(2) THEN Directions
_DISPLAY
LOOP UNTIL _KEYDOWN(27)
Function Grayscale256 (image As Long)
Dim As Long d, s, temp, r, g, b
Dim As _MEM m(1): Dim As _Offset o(1), l
d = _Dest: s = _Source
m(0) = _MemImage(image): o(0) = m(0).OFFSET
temp = _NewImage(_Width(image), _Height(image), 256)
m(1) = _MemImage(temp): o(1) = m(1).OFFSET
_Dest temp: For i = 0 To 255: _PaletteColor i, _RGB32(i): Next: _Dest d
Do
r = _MemGet(m(0), o(0) + 1, _Unsigned _Byte): g = _MemGet(m(0), o(0) + 2, _Unsigned _Byte): b = _MemGet(m(0), o(0) + 3, _Unsigned _Byte)
_MemPut m(1), o(1), _RGB(r, g, b, temp) As _UNSIGNED _BYTE
o(0) = o(0) + 4: o(1) = o(1) + 1
Loop Until o(0) >= (m(0).OFFSET + m(0).SIZE)
Grayscale256 = temp
_MemFree m()
End Function
Function RedScale256 (image As Long)
Dim As Long d, s, temp: d = _Dest: temp = Grayscale256(image)
_Dest temp: For i = 0 To 255: _PaletteColor i, _RGB32(i, 0, 0): Next: _Dest d
RedScale256 = temp
End Function
Function GreenScale256 (image As Long)
Dim As Long d, s, temp: d = _Dest: temp = Grayscale256(image)
_Dest temp: For i = 0 To 255: _PaletteColor i, _RGB32(0, i, 0): Next: _Dest d
GreenScale256 = temp
End Function
Function BlueScale256 (image As Long)
Dim As Long d, s, temp: d = _Dest: temp = Grayscale256(image)
_Dest temp: For i = 0 To 255: _PaletteColor i, _RGB32(0, 0, i): Next: _Dest d
BlueScale256 = temp
End Function
What's this do: It basically works as a superpowered CLOSE statement. Back in the day, when folks used floppy disks and such, it was necessary to use RESET to write your current directory info to the drive track. Before you ever exited a program, and pulled your floppy out of the drive, you'd issue a RESET command to close all files and update all drive information to the floppy.
Nowadays? Who owns a floppy drive? Would a modern OS even require this type of command to update that information, IF you happened to have a floppy drive connected?? I dunno!!
All this command does for us now, is basically just work as a CLOSE statement to close all files. It's unused. Obsoleted. Forgotten...
...Maybe I should've saved this keyword for Memorial Day.
![[Image: Dreidimensionales-Feld2023.jpg]](https://i.ibb.co/4Z6dwd3/Dreidimensionales-Feld2023.jpg)
![[Image: Pandora.jpg]](https://i.ibb.co/2qWt97y/Pandora.jpg)
