Posted by: Pete - 02-28-2024, 10:50 PM - Forum: Programs
- No Replies
His old QB one was never fully finished. It had the ship and missile fire, but Bob hadn't finished the meteor part. So he re-wrote it in QB64PE, and included the meteor effects!
You have to unzip the .rar file to a folder. I'd suggest making a new folder, and then compile and run the smaller of the two .bas programs, SBGFX.bas. in that same folder. It will make the needed images for the game. After that s completed, just compile and run the starbusters.exe program, in that same folder.
So I guess some folks jut couldn't wait a couple more days for QB64 Coding Month!
As the title mentions, it's almost time once again for us to renew our yearly lease on the servers which host the qb64phoenix.com forums and wiki. April 5th is when the bill comes due for the hamster feed that keeps the hamster healthy and running around it's wheel to keep the lights on around here, and our yearly costs are around $300.00 for the renewal.
This year, our Patreon has provided us a little over $100.00 in donations. (Next year, if folks continue to donate at the levels they are now, I'd expect to see the FULL cost of our renewal to be covered. We had several people sign up back in November and pledge donations via Patreon.) That leaves about $200.00 left over, which I'll be happy to personally cover if nobody else wants to step up and help out.
If you DO want to help cover this year's shortfall, you can:
1) Sign up on Patreon and join the recurring monthly donations of $3, $5, or $10! (I know, we ask for a LOT, when that tiny amount won't even pay for a large coffee at Starbucks once a month anymore.) https://www.patreon.com/user?u=86544769
2) If you're one of the folks who prefer to make a one a year donation, or a one-time donation, you can use Paypal and transfer the funds directly to me and I'll add them to help pay the server costs. https://www.paypal.com/paypalme/smcneill1973
3) If you're really "Old School" (like several users of anything QBASIC-adjactent are), you can even MAIL me a check, money order, or US Dollars (if you trust the mail system enough to imagine that cash would get here safely) at:
Steve McNeill
230 McNeil Hill Road
Pilot, VA 24138
(And yes, they named the road after my family. They just spelt it wrong, as if you look close, it only has one "L" in it. Be careful of that as it can cause issues with cashiers checks and money orders and such.)
And that's basically the only ways we accept donations. Patreon, PayPal, or Direct. If those don't work for you, then it's just too much effort to steal your money... err... accept your generous donation!
You've got about 1 month guys, to get your donation in, if you're going to help cover our costs. After that, as I mentioned above, I'll personally cover whatever amount is lacking for us. I honestly don't mind paying these costs to keep everything up and going, but I do have to admit -- after the scare with my open heart surgery and my health and all, I'll be much happier once we get to the point where we're 100% covered in our donations. Next year, we *should* reach that point, as long as nothing changes and prices don't go up (which would be soooo surpising in this hyper-inflation world we're currently living in), and as long as nobody ends up dropping their Patreon subscription. (Which again, I can't blame anyone one bit if they do, with the prices of everything constantly going up and chipping away at everyone's disposable income.)
And while folks are here reading this, you might want to take a look at the PREVIOUS post in the announcement forums -- it's where all the really good stuff is: https://qb64phoenix.com/forum/showthread.php?tid=2469
#438 - Reduced memory impact of the Export As feature for large sources. - @RhoSigma-QB64
#442, #450, #433 - Implemented checks for External Dependencies into the IDE. - @RhoSigma-QB64
Formerly, if changes to $INCLUDE, $EMBED, $EXEICON, $MIDISOUNDFONT or DECLARE LIBRARY files were made while the main source was opened in the IDE, a fake change like adding/removing a line was required to force the IDE to recompile/rebuild the source when pressing F5/F11.
Now you can simply hit F5/F11 again (even after a programming error happened in such external file which is still displayed in the IDE status area) and the IDE will automatically recognize changes to those external files and recompile/rebuild the source as needed. No more fake changes are required.
#444, #447 - Implemented new checksum and hashing functions. - @RhoSigma-QB64
Made in QB64, the goal was to create a psychedelic effect using visuals and sound, so it's not recommended for those sensitive to it.
The background music serves more than setting a mood; every graphic effect changes in sync with specific parts of the music. The smallest unit of graphic change occurs in 1/4th of the time between two beats (approximately 0.1784 seconds). To achieve this, I created a simple tracker program to mark activity in different graphic tracks. Changes are in real-time connection with the background music, and the stereo balance of the narration fluctuates rhythmically with the music.
I intentionally chose a blue-red theme for colors, focusing on 'Chromastereopsis.' Exploiting the visual deviation when perceiving blue and red colors, objects of these colors are perceived at slightly different depths.
In the game, there are visual elements that appear for a very short duration, almost unnoticed. These moments act as "subliminal stimuli." Although there isn't enough time to consciously perceive them, they still imprint on our minds and influence our thoughts. Even when our attention is not focused on them, our consciousness reacts. In theory...
While the audio-visual stimuli can be tiring or even painful for many, those who can appreciate are advised to use headphones for stereo balance control to better 'see' the graphics.
Unfortunately, video compression sometimes skips frames, resulting in a loss of the essence and a reduced psychedelic effect. The 'flash' is missing, and the carefully designed stimuli are experienced only during gameplay.
Another simple one:
What's the best way to skip a data item when searching a file? (the number of items is not known, and the item lengths are varied).
For example, to skip an item and jump to a GetData line in this listing:
MyFile$="MyFile"
Open MyFile$ For Input As #1
' put GetData: here?
While Not EOF(1)
' or GetData: here?
Input #1, data$
If Len(data$) <> 5 Then
GoTo GetData
else
DealWithIt
End If
' or GetData: here
Wend
Close
Forgetting our "phobias" about GoTo for now,
If the GetData point is before the While statement, will this create another loop, and leave the first one unresolved?
If it's just after the While statement, does whe While restart input at the beginning of the file?
Is the position just before the Wend the correct place?
There's been several discussions here recently about _MouseMovementX and _MouseMovementY, and how they don't work 100% as expected in Linux and Mac. Unfortunately, the problem here is an underlying issue with glut itself not reporting that relative movement back to us.
The only real solution at the moment is for one to write their own routine to handle this type of situation, so I thought I'd take a few minutes and write up a quick example of how to do that for someone:
SUBMouse STATICASLONG CurrentX, CurrentY STATICASLONG Pointer 'We need a pointer of some sort for a manual pointer. Here's a cheesy one by default. STATICASINTEGER Init
WHILE_MOUSEINPUT: WEND'catch up to the current mouse's position so we sync properly
X = _MOUSEX: Y = _MOUSEY
MouseMoveX = 0: MouseMoveY = 0
Test that out and see if it doesn't keep track of the current mouse position, while also allowing for mouse movement to take place regardless of the edge of the screen.
Feel free to ask/add any questions, comments, or insights into the process here, but I'm thinking this should work on all OSes without any issues. (As long as _MouseHide works on all OSes... I didn't think to check to see if it does or doesn't, to be honest.)
'convert to the desired type SELECT CASEUCASE$(temp$) CASE"LONG", "&" IF Unsigned THEN
temp~& = num## ConvertTo = temp~& ELSE
temp& = num## ConvertTo = temp& END IF CASE"BIT", "`" IF Unsigned THEN
temp~` = num## ConvertTo = temp~` ELSE
temp` = num## ConvertTo = temp` END IF CASE"BYTE", "%%" IF Unsigned THEN
temp~%% = num## ConvertTo = temp~%% ELSE
temp%% = num## ConvertTo = temp%% END IF CASE"INT", "INTEGER", "%" IF Unsigned THEN
temp~% = num## ConvertTo = temp~% ELSE
temp% = num## ConvertTo = temp% END IF CASE"INT64", "INTEGER64", "_INTEGER64", "&&" IF Unsigned THEN
temp~&& = num## ConvertTo = temp~&& ELSE
temp&& = num## ConvertTo = temp&& END IF CASE"SINGLE", "!"
temp! = num## ConvertTo = temp! CASE"DOUBLE", "#"
temp# = num## ConvertTo = temp# CASE"FLOAT", "_FLOAT", "##"
temp! = num## ConvertTo = temp! END SELECT END FUNCTION
QB64 tries to assign math to the largest type that is involved in the math, and this can sometimes lead to some rather odd results.
DIM UL AS _UNSIGNED LONG
UL = -1
PRINT -1 * UL
Now, most folks would think that -1 * -1 would, of course, be 1.
It's NOT.
The reason is we're multiplying a const value of -1 (which, I think defaults to a LONG type) times an UNSIGNED LONG type, so the return value becomes and UNSIGNED LONG type for us... and who here wants to tell us what the value of -1 is, with an UNSIGNED LONG?? (Hint: It's not 1. )
So add in a simple ConvertTo command in there, make certain that the result is the type that you'd expect to get back, and you can happily do math stuffs forevermore without this type of issue biting you in the butt.
PRINT ConvertTo("Long", -1 * UL) <-- and this would print the LONG value of the result and not the UNSIGNED LONG value.
Would it be easy to add an option to the IDE so that on compile it always re-loads the BI/BM modules?
My reasoning for this is that I usually work on my libraries on my right monitor while I work on my main code on my center monitor. I know you can double-click on the library in the main code and edit the library and such, but that is not how my libraries are set up.
My libraries are set up so that the BI/BM files are a single working .BAS file. I have a place for code within this .BAS file that I can use to test the library when editing or fixing bugs. When I have things working as expected, I have a program that takes this .BAS program and splits apart the BI/BM files (removes the test code), and places my comments within the library in a Word file (each Sub/Function's comments are separated & highlighted with documentation below). This allows me to edit the .BAS library file as needed, test everything, and it will automatically update the BI/BM and generate the documentation. For me it is much easier.
If you a re wondering why I do it this way, it allows me to write the code for the library and test it by simply pressing F5. I never have to go down to the include line to click on the file to edit the code separately and then back to testing. I edit/run, edit/run...etc until it works. Edit as if it were just a plain .BAS program and not a library. Easier for me.
Currently I force the IDE to reload the libraries by inserting a foreign character into the file name, move up a line (it flags as an error), move back down a line and remove the foreign character. It works, just a PITA.
Here are a few routines I wrote to store and retrieve a string that can be embedded within an image.
Think of this as writing a description on the back of a photograph. The image itself will contain its own description.
The embedded string can be anything; text, another image, even another file. There are limits on the string size though (see comments in code).
The code below includes sample code that will load 9 photos that have already had string embedded into them. The photos will display a caption that was decoded from the embedded string. The 9 photos are in the ZIP file below.
This code is just a proof on concept for me. It's highly inefficient but extremely fast. Go ahead and see what you can do, or modify, with it.
Code: (Select All)
'
' Encode/Decode Routines
' by Terry Ritchie 02/23/24
'
'+-----------------------------------------------------------------------------------------------+
'| Routines to encode and decode a string within an image. |
'| |
'| Possible uses: |
'| |
'| - Embed a description of the image into the image, like writing on the back of a photograph. |
'| - Secret spy stuff, pass messages embedded in images to friends. |
'| - Embed another file or image within an image. |
'| |
'| Notes: |
'| |
'| - These routines only work with 32bit images. |
'| - It's best to use images that are opague (all alpha values = 255 such as photographs) |
'| - The formula to determine the maximum string length an image can hold is: |
'| |
'| String_Size = (Image_Width x Image_Height \ 8) - 6 |
'| |
'+-----------------------------------------------------------------------------------------------+
OPTION _EXPLICIT ' declare those variables!
CONST SWIDTH = 800 ' screen width
CONST SHEIGHT = 600 ' screen height
DIM Image AS LONG ' image to load
DIM DecodedText AS STRING ' decoded string from image
DIM p AS INTEGER ' photo counter
'**
'** BEGIN EXAMPLE CODE: cycle through 9 photos that have encoded strings within them
'**
SCREEN _NEWIMAGE(SWIDTH, SHEIGHT, 32)
FOR p = 1 TO 9
Image = _LOADIMAGE("Photo" + _TRIM$(STR$(p)) + ".png", 32) ' load the image
DecodedText = DecodeImage(Image) ' decode string inside image
Display_Image Image, DecodedText, 1 ' show image and decoded caption
_FREEIMAGE Image ' free the image
NEXT p
SYSTEM
SUB Display_Image (i AS LONG, s AS STRING, p AS INTEGER)
CLS
_PUTIMAGE ((SWIDTH - _WIDTH(i)) \ 2, (SHEIGHT - _HEIGHT(i)) \ 2), i
LOCATE 2, ((SWIDTH \ 8) - LEN(s)) \ 2
PRINT s;
IF p THEN
LOCATE (SHEIGHT \ 16) - 1, ((SWIDTH \ 8) - 11) \ 2
PRINT "PRESS A KEY";
SLEEP
END IF
END SUB
'**
'** END EXAMPLE CODE
'**
'**
'** EXAMPLE: Saving an entire file within an image.
'**
'ff = FREEFILE ' get a free file handle
'OPEN "readme.md" FOR BINARY AS #ff ' open text file
'Text$ = SPACE$(LOF(ff)) ' create a string the size of file
'GET #ff, , Text$' get text as one string
'CLOSE #ff ' close text file
'Image& = _LOADIMAGE("photo.png", 32) ' load image to encode string into
'EncodedImage& = EncodeImage(Image&, Text$) ' encode string within image
'_SAVEIMAGE "EncodedPhoto.png", EncodedImage& ' save encoded image (use a non lossy format!)
'_FREEIMAGE Image& ' remove image from memory
'_FREEIMAGE EncodedImage& ' remove encoded image from memory
' ______________________________________________________________________________________________________
'/ \
FUNCTION EncodeImage& (i AS LONG, st AS STRING) ' EncodeImage& |
' __________________________________________________________________________________________________|____
'/ \
'| Embeds a string within an image. |
'| |
'| i - image to encode |
'| st - string to encode within image |
'| |
'| Returns: handle of new encoded image (-2 or less) |
'| -1 if an error occurred |
'| |
'| Note: Only works with 32 bit images |
'| |
'| The string is converted to a series of 1's and 0's that will be used to determine the alpha level of |
'| each pixel within the image. Therefore, each character in the string (a byte) will need 8 pixels to |
'| store the equivalent binary value. A binary value of 1 will set a pixel's alpha level to 255 and a |
'| binary value of 0 will set a pixel's alpha level to 254. This very slight variation in alpha levels |
'| will be imperceivable to the naked eye when viewing the image. |
'| A header and footer of 3 bytes is added to beginning and end of the string data. The header is used |
'| to identify that encoded information is contained within the image. The footer identifies the end of |
'| the string data contained within the image. |
'| |
'| The size of an image will determine the maximum size of the encoded string it can hold. |
'| |
'| String_Size = (Image_Width x Image_Height \ 8) - 6 |
'\_______________________________________________________________________________________________________/
DIM m AS _MEM ' memory block of image
DIM em AS _MEM ' memory block of image to encode
DIM ei AS LONG ' copy of image to encode
DIM s AS STRING ' string to encode within image
DIM p AS LONG ' position within string
DIM o AS _OFFSET ' pixel offset within memory block
DIM c AS _UNSIGNED _BYTE ' single character value within string
DIM a AS _UNSIGNED _BYTE ' pixel alpha value to write
DIM b AS _BYTE ' bit counter
DIM b(7) AS _UNSIGNED _BYTE ' place value of bit counter
DIM HeadFoot AS STRING * 3 ' string header and footer
'+-------------------------------------------------------------------------------------------------------+
'| Check for a valid image before proceeding. |
'| ========================================== |
'+------------------------------+ |
EncodeImage& = -1 ' | assume this image is invalid |
IF i < -1 THEN ' | is this a valid image handle? |
IF _PIXELSIZE(i) = 4 THEN ' | is this a 32 bit color image? |
' +------------------------------------------------------------------------+
'+-----------------------------------------------------------------------------------------------+
'| Store binary place holder values |
'| ================================ |
'+-----------+ |
b(0) = 1 ' | define 8 bit binary place values |
b(1) = 2 ' | |
b(2) = 4 ' | |
b(3) = 8 ' | |
b(4) = 16 ' | |
b(5) = 32 ' | |
b(6) = 64 ' | |
b(7) = 128 ' | |
' +-----------------------------------------------------------------------------------+
'+-----------------------------------------------------------------------------------------------+
'| Add an identifying header and footer to string Note: The possibility of this header/ |
'| ============================================== footer combination found in a |
'+-------------------------------+ string will be very low but not |
HeadFoot = "U" + CHR$(0) + "U" ' | 010101010000000001010101 a zero chance. May want to scan |
s = HeadFoot + st + HeadFoot ' | add header and footer before proceeding. ( use INSTR ) |
' +---------------------------------------------------------------+
'+-----------------------------------------------------------------------------------------------+
'| Use image memory manipulation for speed |
'| ======================================= |
'+-----------------+ |
m = _MEMIMAGE(i) ' | create image memory block |
' +-----------------------------------------------------------------------------+
'+-----------------------------------------------------------------------------------------------+
'| Ensure that the string will fit inside the image |
'| ================================================ |
'+-----------------------------+ |
IF LEN(s) > m.SIZE \ 32 THEN ' | will string fit into image? |
_MEMFREE m ' | no, free image memory block |
s = "" ' | clear variable |
ELSE ' | Yes, the string will fit |
' +-----------------------------------------------------------------+
'+-------------------------------------------------------------------------------------------+
'| Turn error checking off for speed |
'+-------------------------------------------------------------------------------------------+
$CHECKING:OFF
'+-------------------------------------------------------------------------------------------+
'| Use image memory manipulation for speed |
'| ======================================= |
'+-------------------+ |
ei = _COPYIMAGE(i) ' | create image to encode |
em = _MEMIMAGE(ei) ' | create image to encode memory block |
' +-----------------------------------------------------------------------+
'+-------------------------------------------------------------------------------------------+
'| Endcode string into image |
'| ========================= |
'+------------------------------------------------+ |
p = 1 ' | start at text position 1 |
o = 0 ' | reset pixel offset location |
DO ' | begin encoding loop |
c = ASC(s, p) ' | get next character value in string |
b = 0 ' | reset bit counter |
DO ' | begin bit identification loop |
IF c AND b(b) THEN a = 255 ELSE a = 254 ' | 255 = 1, 254 = 0 |
_MEMPUT em, em.OFFSET + o + 3, a ' | adjust alpha value in encoded image |
o = o + 4 ' | next pixel position in memory block |
b = b + 1 ' | next bit in character |
LOOP UNTIL b = 8 ' | leave when all 8 bits processed |
p = p + 1 ' | next character in string |
LOOP UNTIL p > LEN(s) ' | leave when string exhausted |
_MEMFREE m ' | free image memory block |
_MEMFREE em ' | free encoded image memory block |
' +------------------------------------------+
'+-------------------------------------------------------------------------------------------+
'| Turn error checking back on |
'+-------------------------------------------------------------------------------------------+
$CHECKING:ON
'+-------------------------------------------------------------------------------------------+
'| Return handle of encoded image |
'| ============================== |
'+------------------+ |
EncodeImage& = ei ' | return handle of encoded image |
' +------------------------------------------------------------------------+
END IF
END IF
END IF
END FUNCTION
' ______________________________________________________________________________________________________
'/ \
FUNCTION DecodeImage$ (i AS LONG) ' DecodeImage$ |
' __________________________________________________________________________________________________|____
'/ \
'| Extracts a coded string from within an image. |
'| |
'| i - image to decode |
'| |
'| Returns: string extracted from image |
'| null if no coded string was found within image or an error occurred |
'| |
'| Note: Only works with 32 bit images |
'\_______________________________________________________________________________________________________/
DIM m AS _MEM ' memory block of image
DIM e AS _OFFSET ' end of memory block
DIM s AS STRING ' string containing decoded data
DIM c AS _UNSIGNED _BYTE ' single character value
DIM o AS _OFFSET ' pixel offset within memory block
DIM a AS _UNSIGNED _BYTE ' pixel alpha value
DIM b AS _BYTE ' bit counter
DIM b(7) AS _UNSIGNED _BYTE ' place value of bit counter
DIM HeadFoot AS STRING * 3 ' string header and footer
DIM Done AS _BYTE ' finished processing flag
'+-------------------------------------------------------------------------------------------------------+
'| Check for a valid image before proceeding. |
'| ========================================== |
'+------------------------------+ |
s = "" ' | assume this image is invalid |
IF i < -1 THEN ' | is this a valid image handle? |
IF _PIXELSIZE(i) = 4 THEN ' | is this a 32 bit color image? |
' +------------------------------------------------------------------------+
'+-----------------------------------------------------------------------------------------------+
'| Store binary place holder values |
'| ================================ |
'+-----------+ |
b(0) = 1 ' | define 8 bit binary place values |
b(1) = 2 ' | |
b(2) = 4 ' | |
b(3) = 8 ' | |
b(4) = 16 ' | |
b(5) = 32 ' | |
b(6) = 64 ' | |
b(7) = 128 ' | |
' +-----------------------------------------------------------------------------------+
'+-----------------------------------------------------------------------------------------------+
'| Use image memory manipulation for speed |
'| ======================================= |
'+----------------------+ |
m = _MEMIMAGE(i) ' | create image memory block |
e = m.OFFSET + m.SIZE ' | end of memory block |
' +------------------------------------------------------------------------+
'+-----------------------------------------------------------------------------------------------+
'| Turn error checking off for speed |
'+-----------------------------------------------------------------------------------------------+
$CHECKING:OFF
'+-----------------------------------------------------------------------------------------------+
'| Extract string from image |
'| ========================= |
'+---------------------------------------+ |
HeadFoot = "U" + CHR$(0) + "U" ' | 010101010000000001010101 string header and footer |
Done = 0 ' | reset finished flag |
s = "" ' | reset string |
o = 0 ' | reset pixel offset |
DO ' | cycle through image pixels |
b = 0 ' | reset bit count |
c = 0 ' | reset character value |
DO ' | cycle through character bits |
_MEMGET m, m.OFFSET + o + 3, a ' | get alpha value of pixel |
IF a = 255 THEN c = c + b(b) ' | if 1 then add place value |
b = b + 1 ' | increment bit counter |
o = o + 4 ' | increment to next image pixel |
LOOP UNTIL b = 8 ' | leave when 8 bits examined |
s = s + CHR$(c) ' | add character to string |
'+-----------------------------------+ |
'| Search for string header |
'| ======================== |
'+------------------------------------+ |
IF o = 96 THEN ' | first 3 characters extracted |
IF s <> HeadFoot THEN Done = -1 ' | report encoded string not found if no header |
s = "" ' | remove header (null return for no header found) |
ELSE ' | beyond first 3 characters |
'+--------------------------------+ |
'| Search for string footer |
'| ======================== |
'+--------------------------------+ |
IF RIGHT$(s, 3) = HeadFoot THEN ' | check for footer (end of string) |
Done = -1 ' | report encoded string found |
s = LEFT$(s, LEN(s) - 3) ' | remove footer |
END IF ' | |
END IF ' | |
LOOP UNTIL (o = e) OR Done ' | leave at end of memory block or done processing |
_MEMFREE m ' | free memory block |
' +------------------------------------------------------+
'+-----------------------------------------------------------------------------------------------+
'| Set string to null if a footer was not found (image corruption perhaps?) |
'| ============================================ |
'+------------------------+ |
IF Done = 0 THEN s = "" ' | a footer was not found |
' +----------------------------------------------------------------------+
'+-----------------------------------------------------------------------------------------------+
'| Turn error checking back on |
'+-----------------------------------------------------------------------------------------------+
$CHECKING:ON
END IF
END IF
'+-------------------------------------------------------------------------------------------------------+
'| Return string found |
'| =================== |
'+-----------------+ |
DecodeImage$ = s ' | return string |
' +-------------------------------------------------------------------------------------+
END FUNCTION
' ______________________________________________________________________________________________________
'/ \
FUNCTION EncodedStringExists% (i AS LONG) ' EncodedStringExists% |
' __________________________________________________________________________________________________|____
'/ \
'| Tests an image for an encoded string. |
'| |
'| i - image to test for encoded string |
'| |
'| Returns: 0 if no encoded string found |
'| -1 if an encoded string was found |
'\_______________________________________________________________________________________________________/
DIM m AS _MEM ' memory block of image
DIM e AS _OFFSET ' end of memory block
DIM s AS STRING ' string containing decoded data
DIM c AS _UNSIGNED _BYTE ' single character value
DIM o AS _OFFSET ' pixel offset within memory block
DIM a AS _UNSIGNED _BYTE ' pixel alpha value
DIM b AS _BYTE ' bit counter
DIM b(7) AS _UNSIGNED _BYTE ' place value of bit counter
DIM HeadFoot AS STRING * 3 ' string header and footer
'+-------------------------------------------------------------------------------------------------------+
'| Check for a valid image before proceeding. |
'| ========================================== |
'+------------------------------+ |
EncodedStringExists% = 0 ' | assume this image is invalid |
IF i < -1 THEN ' | is this a valid image handle? |
IF _PIXELSIZE(i) = 4 THEN ' | is this a 32 bit color image? |
' +------------------------------------------------------------------------+
'+-----------------------------------------------------------------------------------------------+
'| Turn error checking off for speed |
'+-----------------------------------------------------------------------------------------------+
$CHECKING:OFF
'+-----------------------------------------------------------------------------------------------+
'| Store binary place holder values |
'| ================================ |
'+-----------+ |
b(0) = 1 ' | define 8 bit binary place values |
b(1) = 2 ' | |
b(2) = 4 ' | |
b(3) = 8 ' | |
b(4) = 16 ' | |
b(5) = 32 ' | |
b(6) = 64 ' | |
b(7) = 128 ' | |
' +-----------------------------------------------------------------------------------+
'+-----------------------------------------------------------------------------------------------+
'| Use image memory manipulation for speed |
'| ======================================= |
'+----------------------+ |
m = _MEMIMAGE(i) ' | create image memory block |
e = m.OFFSET + m.SIZE ' | end of memory block |
' +------------------------------------------------------------------------+
'+-----------------------------------------------------------------------------------------------+
'| Extract header from image |
'| ========================= |
'+---------------------------------------+ |
HeadFoot = "U" + CHR$(0) + "U" ' | 010101010000000001010101 string header and footer |
s = "" ' | reset string |
o = 0 ' | reset pixel offset |
DO ' | cycle through image pixels |
b = 0 ' | reset bit count |
c = 0 ' | reset character value |
DO ' | cycle through character bits |
_MEMGET m, m.OFFSET + o + 3, a ' | get alpha value of pixel |
IF a = 255 THEN c = c + b(b) ' | if 1 then add place value |
b = b + 1 ' | increment bit counter |
o = o + 4 ' | increment to next image pixel |
LOOP UNTIL b = 8 ' | leave when 8 bits examined |
s = s + CHR$(c) ' | add character to string |
LOOP UNTIL (o = e) OR (o = 96) ' | leave at end of memory block or 3 characters retrieved|
_MEMFREE m ' | free memory block |
' +-------------------------------------------------------+
'+-----------------------------------------------------------------------------------------------+
'| Turn error checking back on |
'+-----------------------------------------------------------------------------------------------+
$CHECKING:ON
'+-----------------------------------------------------------------------------------------------+
'| Return status of string within image |
'| ==================================== |
'+-----------------------------------------------+ |
IF s = HeadFoot THEN EncodedStringExists% = -1 ' | return -1 if header found |
' +-----------------------------------------------+
END IF
END IF
This time we start out with simple "Blinker" in the 2D version and see what becomes of it in 3D version per parallelism:
Code: (Select All)
_Title "3D per Parallelism test Game of Life - hold enter to reset" ' started Parallelism b+ 2024-02-20
' "parallelism suggests a connection of meaning through an echo of form"
' 2024-02-21 Pyramid 2 screw around with pyramid numbers fix projection formula
' 2024-02-21 now test cubes with DrawCube sub
' 2024-02-21 return to Pyramid 2 and fix that according to how this Project sub works.
' 2024-02-22 test Game of Life code from thisversion of DrawCube
' Ah! apply some tips I learned with 3D Rendering of Game of Life
Dim Shared As Long SW, SH: SW = 720: SH = 720
Screen _NewImage(SW, SH, 32)
_ScreenMove 280, 0
Randomize Timer
Type XYZ
As Single x, y, z
End Type
Type XY
As Single x, y
End Type
Dim Shared PC: PC = .35 ' or something PC = Parallel Constant
Window (-15, 35)-(35, -15) ' setup for 3D
' setup for Game of Life
Dim As Integer xmin, xmax, ymin, ymax, zmin, zmax
xmin = 1: xmax = 30: ymin = 1: ymax = 30: zmin = 1: zmax = 30
Dim As Integer x, y, z, r, g, b, mm, xx, yy, zz, rr, gg, bb, gen
Color &HFFDDDDFF, &HFF000000
ResetStart:
gen = 0
ReDim As Integer U(xmin To xmax, ymin To ymax, zmin To zmax), U2(xmin To xmax, ymin To ymax, zmin To zmax)
'For z = zmin + 10 To zmax - 10
' For x = xmin + 10 To xmax - 10
' For y = ymin + 10 To ymax - 10
' If Rnd > .9 Then U(x, y, z) = 1
'Next y, x, z
Do
Cls
_PrintString (10, 10), "Generation:" + Str$(gen) + " press any for next, escape to quit... "
r = rr: g = gg: b = bb
For z = zmin + 1 To zmax - 1
r = r * 1.04: g = g * 1.04: b = b * 1.04
For x = xmin + 1 To xmax - 1
For y = ymin + 1 To ymax - 1
If U(x, y, z) = 1 Then
drawCube x, y, z, .9, _RGB32(r, g, b)
End If
Next y, x
_Display
_Limit 30
Next z
_Display
Sleep
If _KeyDown(13) Then Cls: _Delay .5: GoTo ResetStart
For z = zmin + 1 To zmax - 1
For x = xmin + 1 To xmax - 1
For y = ymin + 1 To ymax - 1
mm = 0
For xx = x - 1 To x + 1
For yy = y - 1 To y + 1
For zz = z - 1 To z + 1
If x = xx And y = yy And z = zz Then
Else
If U(xx, yy, zz) = 1 Then mm = mm + 1
End If
Next zz, yy, xx
If (mm > 1) And (mm < 4) Then ' neighbors for birth
U2(x, y, z) = 1
ElseIf U(x, y, z) = 1 And mm = 3 Then ' neighbors to survive
U2(x, y, z) = 1
Else
U2(x, y, z) = 0
End If
Next y, x
Next z
For z = zmin + 1 To zmax - 1
For x = xmin + 1 To xmax - 1
For y = ymin + 1 To ymax - 1
U(x, y, z) = U2(x, y, z)
Next y, x, z
gen = gen + 1
Loop Until _KeyDown(27)
Sub drawCube (cx, cy, cz, side, colr~&) 'draw a cube on screen from an xyz() 3D array
Dim As Integer i, r, g, b
Dim sd2, lx, rx, ty, by, fz, bz
Dim c2 As _Unsigned Long
r = _Red32(colr~&): g = _Green32(colr~&): b = _Blue32(colr~&)
ReDim corners(0 To 7) As XYZ
sd2 = side / 2
rx = cx + sd2: lx = cx - sd2
ty = cy + sd2: by = cy - sd2
fz = cz + sd2: bz = cz - sd2
'bck face
corners(0).x = lx: corners(0).y = ty: corners(0).z = bz
corners(1).x = rx: corners(1).y = ty: corners(1).z = bz
corners(2).x = rx: corners(2).y = by: corners(2).z = bz
corners(3).x = lx: corners(3).y = by: corners(3).z = bz
'frt face
corners(4).x = lx: corners(4).y = ty: corners(4).z = fz
corners(5).x = rx: corners(5).y = ty: corners(5).z = fz
corners(6).x = rx: corners(6).y = by: corners(6).z = fz
corners(7).x = lx: corners(7).y = by: corners(7).z = fz
ReDim xy(0 To 7) As XY
For i = 0 To 7
Project corners(i), xy(i) ' take a corner x,y,z and convert to screen coordinates x,y
Next
' steves latest version to check out, seems to be working OK
Sub FillTriangle (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
$Checking:Off
Static a&, m As _MEM
If a& = 0 Then a& = _NewImage(1, 1, 32): m = _MemImage(a&)
_MemPut m, m.OFFSET, K
_MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
$Checking:On
End Sub
' here I am working with a Window so Screen obeys right hand rule so as z increases
' the image x, y plane is closer to the eye/camera so is bigger
' but should be distance squared
' thankyou vince '2024-02 the bigger the Z the closer it is to the eye the greater the image
Sub Project (pIN As XYZ, pOut As XY) 'M2SPP = Model (3D) 2 Screen Per Parallelism
pOut.x = pIN.x - PC * pIN.z
pOut.y = pIN.y - PC * pIN.z
End Sub
It's Alive! well at least until it blows it's symmetry
