Hi friends
playing with Informpe here in the code you can see :
how to open a webpage,
how to compile a QB64 program with command line
and how to save code to inspect it with your preferred IDE or Text editor.
In the while you can see how to activate an event for the controls that hadn't naturally that event in Inform_pe library.
Moreover you can see how to emulate a text editor with a Picturebox.
But this is only the start, using the program you can learn the principles of speed coding in QB64pe.
Those aren't mine but I find them so useful and I see some interest of these community about them that I wanted summarize them and build different demos.
The code of demos are written by me except for some examples taken with permission from SmcNeill treasure box.
Each demo has the goal to go straight to show what advantage you take using that tip or principle of coding.
It is difficult for some principles to be used alone so you can see in the same demo the use of two or more speed principles.
The theory of these principles has been discussed into this thread on the forum speed thread
I have posted this program here but it should be visible also in Informpe section, and in Learning resource.
here a screenshot
User's guide:
launch the program ,
select a method on the left, you can read the whole name/comment to the method in the cloud of tooltip
click on the code showed in the right white space, using the arrow keys and Home, End, PageUp and PageDown keys you can navigate the code.
select the button Visit Forum to open the webpage from which has been taken the informations of speed coding
select the Run Code button to compile and run the code showed into the right part of program
select the Export Code butto to get a file.BAS with the name of the tip and his author if it has not been coded by me. The file has saved in the folder of the program SpeedBible. In this same folder there is the folder of Asset.
---------------------------------------------------------------------
Guide for download and compiling
1. download the zip file SpeedBible Informpe.7z
2. make a folder in the Qb64pe folder of your preferred name (i.e. SpeedBible)
3. unzip in this last folder (i.e. SpeedBible) , you'll get the source code (*.BAS and *.frm) and the Asset folder
4. if you have installed Inform pe jump to the step 6
5. download Informpe or the zip file InformPackageIncludeFiles.7z and unpack it into your Speedbible folder
6. open SpeedBible.BAS in your QB64pe IDE and compile with F5
7. click and run the SpeedBible.EXE
I think that there is no issue for Linux and Mac because it has not been used any keyword specific for Windows Os.
----------------------------------------------------------------------
Thanks to QB64pe team for their suggestions.
Posted by: PhilOfPerth - 06-11-2025, 05:49 AM - Forum: Games
- No Replies
This is my version of the card-game Snap, that most of us have played at some time.
I've made a few changes from the original; I think that's called poetic licence.
' Ctr is text horiz centre of screen
' GCtr is pixel horiz centre of screen
' OK$,Bad$ and Finish$ are sound strings
' NumStacks is selected number of stacks
' StackHoriz() is horiz pixel position of each stack
' Place is flag for Random or Sequential flip positions
' Place$ is text of flip position type
' stacknum is number of the stack addressed
' Stack() holds number of each stack's last flipped card
' FlipNum is current number of flips (used for value of claims)
' Flip is number of the card being flipped, 1 to 20
' Card$(20) is array of card pics (4 sets of 20)
' Claimer is number of the player claiming (swapped to opponent if claim fails)
' Match is flag for match success (1) or fail (0)
' Place is o for random, 1 for sequential stacks for flips
' Dely is delay time between flips
Options:
Centre "To toggle the setting for any option, press the Option Number (1 to 5)", 12: White
WIPE "14"
Restore
For a = 1 To SetNum: Read settype$: Next
txt$ = "1 Image Set: Set" + Str$(SetNum) + "(" + settype$ + ")"
Locate 14, 22: Print txt$
WIPE "15"
txt$ = "2 Number of Stacks: " + Str$(NumStacks) + " Stacks"
Locate 15, 22: Print txt$
WIPE "16"
txt$ = "3 Delay between Flips: "
If Dely < 1 Then txt$ = txt$ + "0"
txt$ = txt$ + LTrim$(Str$(Dely)) + " sec"
Locate 16, 22: Print txt$
WIPE "17"
txt$ = "4 Winning Score: " + Str$(WinScore) + " points"
Locate 17, 22: Print txt$
WIPE "18"
txt$ = "5 Flip Position: " + Place$
Locate 18, 22: Print txt$
Yellow: Centre "Press any other key when all options are ok", 20
While InKey$ <> "": Wend
k$ = ""
While k$ = "": k$ = InKey$: Wend
Select Case k$
Case "1"
ChooseSet
Case "2"
ChooseNumStacks
Case "3"
ChooseSpeed
Case "4"
ChooseWinScore
Case "5"
ChooseRandStack
Case Else
GoTo GetNames
End Select
GoTo Options
_KeyClear: Play OK$
GetNames:
Cls
_KeyClear
Centre "Name for player 1", 15
Locate 16, 38
Input Name$(1)
Name$(1) = UCase$(Name$(1))
If Name$(1) < "A" Then Name$(1) = "PLAYER1"
WIPE "16"
If Len(Name$(1)) > 7 Then Name$(1) = Left$(Name$(1), 7)
Centre Name$(1), 16
_Delay .5: WIPE "16"
_KeyClear
Centre "Name for player 2", 15
Locate 16, 38
Input Name$(2)
Name$(2) = UCase$(Name$(2))
If Name$(2) < "A" Then Name$(2) = "PLAYER2"
WIPE "16"
If Len(Name$(2)) > 7 Then Name$(2) = Left$(Name$(2), 7)
Centre Name$(2), 16
_Delay .5: Cls
If Name$(1) = Name$(2) Then Name$(1) = Name$(1) + "1": Name$(2) = Name$(2) + "2" ' if same name, separate them
Cls
SetStackPositions:
Dim FrameHoriz(NumStacks), Stack(NumStacks), Card(NumStacks)
LHS = GCtr - NumStacks * 27 ' LHS of first stack
match = 0: k = 0
FlipLoop:
Yellow: Centre "Press your Shift key when you see a matching pair", 20
Yellow: For a = 1 To NumStacks
FrameHoriz(a) = LHS + a * 54 - 54 '
PSet (FrameHoriz(a), 198): Draw "r54d54l54u54"
Next
_KeyClear: Claim = 0
While Claim < 1
StackNum = StackNum + 1: If StackNum > NumStacks Then StackNum = 1 ' inc stack (cycloic)
If place = 0 Then StackNum = Int(Rnd * NumStacks) + 1
NumFlips = NumFlips + 1
StackHoriz = FrameHoriz(StackNum) + 2
Card(StackNum) = Int(Rnd * 20) + 1
Tile = _LoadImage("recpics" + LTrim$(Chr$(SetNum + 48)) + "/" + Chr$(64 + Card(StackNum)) + ".jpg")
_PutImage (StackHoriz, 200)-(StackHoriz + 50, 250), Tile
_Delay Dely
Claimer = 100305 - _KeyHit ' leftshift 1, rightshift 2
If Claimer = 1 Or Claimer = 2 Then Exit While
' Locate 1, 1: Print "claimer is"; Claimer: Sleep 2
WIPE "27"
txt$ = "Flipped:" + Str$(NumFlips)
Centre txt$, 27
Centre "Scores", 1
txt$ = Name$(1) + ":" + Str$(Score(1)) + Space$(20) + Name$(2) + ":" + Str$(Score(2))
Centre txt$, 2
Wend
CheckMatch
GoTo FlipLoop
Sub ChooseSet ' returns with next setnum
WIPE "14"
SetNum = SetNum + 1: If SetNum > 4 Then SetNum = 1
Restore Types
For a = 1 To SetNum: Read settype$: Next
txt$ = "1 Image Set: Set" + Str$(SetNum) + "(" + settype$ + ")"
Locate 14, 22: Print txt$
End Sub
Sub ChooseNumStacks
WIPE "15"
NumStacks = NumStacks + 1: If NumStacks > 5 Then NumStacks = 2
txt$ = "2 Number of Stacks: " + Str$(NumStacks) + " Stacks"
Locate 15, 22: Print txt$
End Sub
Sub ChooseSpeed
WIPE "16"
Dely = Int(Dely * 10 + 2) / 10: If Dely > 2 Then Dely = .2
txt$ = "3 Delay between Flips: " + Str$(Dely) + " sec"
Locate 16, 22: Print txt$
End Sub
Sub ChooseWinScore
WIPE "17"
WinScore = WinScore + 50: If WinScore > 250 Then WinScore = 50
txt$ = "4 Winning Score: " + Str$(WinScore) + " points"
Locate 17, 22: Print txt$
End Sub
Sub ChooseRandStack
WIPE "18"
If place = 1 Then
place = 0
Place$ = "Random"
Else
place = 1
Place$ = "Sequential"
End If
txt$ = "5 Flip Position: " + Place$
Locate 18, 22: Print txt$
End Sub
Sub CheckMatch ' a claim has been made by Claimer
match = 0
For a = 1 To NumStacks ' check each card against every other card for a match
For b = 1 To NumStacks
If Card(a) = Card(b) And a <> b And Card(a) <> 0 Then match = 1: Exit For ' if same card for A and B (or if empty), ignore match
Next
Next
If match = 0 Then ' if no matches
Play Bad$: Centre "No Match!", 18
If Claimer = 1 Then Claimer = 2 Else Claimer = 1 ' switch claim to other player
Else
Play OK$: Centre "A Match!", 18 ' (if a match was found, no switch is made)
End If
txt$ = Str$(NumFlips) + " points awarded to " + Name$(Claimer)
Centre txt$, 16
Score(Claimer) = Score(Claimer) + NumFlips ' award Claimer with cards flipped
Centre "Scores", 1
WIPE "02"
txt$ = Name$(1) + ":" + Str$(Score(1)) + Space$(20) + Name$(2) + ":" + Str$(Score(2))
Centre txt$, 2
If Score(Claimer) >= 50 Then EndGame
NumFlips = 0: StackNum = 0 ' reset Flips count and reset to stack 1
Sleep 2: WIPE "1618"
Black
For a = 1 To NumStacks
StackHoriz = FrameHoriz(a) + 2
Line (StackHoriz, 200)-(StackHoriz + 50, 250), , BF ' clear the satck displays
Card(a) = 0: Claimer = 0
Next
End Sub
Sub EndGame
Cls
Play Finish$
Centre "Scores", 13
txt$ = Name$(1) + ":" + Str$(Score(1)) + Space$(20) + Name$(2) + ":" + Str$(Score(2))
Centre txt$, 15
txt$ = "Congratulations, " + Name$(Claimer)
Centre txt$, 17
Sleep: System
End Sub
Sub Yellow
Color _RGB(255, 255, 0)
End Sub
Sub White
Color _RGB(255, 255, 255)
End Sub
Sub Red
Color _RGB(255, 0, 0)
End Sub
Sub Black
Color _RGB(0, 0, 0)
End Sub
Sub WIPE (LN$)
If Len(LN$) = 1 Then LN$ = "0" + LN$
For A = 1 To Len(LN$) - 1 Step 2
WL = Val(Mid$(LN$, A, 2))
' Locate WL, 1: Print String$(5, "X"): _Delay .5 (test line)
Locate WL, 1: Print Space$(CPL - 1)
Next
End Sub
Sub Centre (Txt$, LineNum)
Locate LineNum, Ctr - Len(Txt$) / 2
Print Txt$;
End Sub
Sub Instructions
Yellow: Centre "Snap - a Reflex game for two Players", 7
txt$ = "based on the card game of " + Chr$(34) + "Snap" + Chr$(34)
Centre txt$, 8: White: Print: Print
Print " This game uses a large pack of cards, each holding one of 20 images. Before"
Print " the game begins, players choose to have the cards ";: Yellow: Print "Flipped";: White: Print " onto either two,"
Print " three, four or five";: Yellow: Print " stacks";: White: Print "; the type of images they prefer (Animals, Letters,"
Print " Shapes, or Objects); and several other options.": Print
Print " One of the cards is Flipped onto each of the Stacks in turn, but only the"
Print " last card flipped to each stack remains visible. Players wait for any two of"
Print " the visible cards to match, and when they do, they press their key (Left or"
Print " Right Shift) to ";: Yellow: Print "Snap";: White: Print " them.": Print
Print " If the cards match, the player who snapped first has the number of flipped"
Print " cards added to their score. If they don't match, their opponent scores the"
Print " points. The stacks are then cleared, and the game continues. When a player"
Print " has scored the selected winning number of points, the game ends.": Print
Yellow: Centre "Press a key to begin", 25
Sleep: Cls
End Sub
So a guy over on the other discord was asking for some help trying to salvage an old program he pulled off a floppy disk.
QB45 errors out "Bad File Mode" when trying to open it there to convert to plain text
and the QB64 converter runs for a while then errors out.
program is attached if anybody else wants to take a hack at getting any data out of it.
Posted by: PhilOfPerth - 06-06-2025, 11:17 PM - Forum: Games
- No Replies
This is the completed version of a game I presented earlier, but with mouse support and other enhancements.
Its aim is to provide memory-improvement and testing. It has a "Best Score" function as well as a "History List",
which keeps a record of all players' progress through all of its 10 levels of difficulty.
Constructive comments are welcome.
' A VERSION OF JOHN CONWAY'S GAME OF LIFE
' for more info see https://en.wikipedia.org/wiki/Conway%27s_Game_of_Life
' -----------------------------------------------------------------------------
' New in this version
' -----------------------------------------------------------------------------
' * Fixed logic issues, program now works as expected!
' * Fixed population count
' -----------------------------------------------------------------------------
' Instructions
' -----------------------------------------------------------------------------
' 1. Choose whether organisms will be allowed to age.
' Select "n" for classic Conway's Game of Life where organisms don't age,
' or "y" for aging, where organisms are born and grow with each generation,
' and then die of old age after 5 generations.
' 2. Choose whether organisms are placed randomly on the virtual planet.
' 3. If you selected random, enter # of organisms to generate (or 0 to pick a random number).
' The specified number of organisms are added to the virtual planet.
' 4. If you selected NOT random, an editor opens where you place each organism manually.
' a. Use mouse to position the cursor.
' b. Left click to add an organism at the cursor position.
' If aging is enabled, click again to make the organism older.
' c. Right click to remove organism at the cursor position.
' d. Press "r" to randomly add a new organism.
' e. When finished adding organisms, press Escape to begin the simulation.
' 5. The simulation proceeds according to the rules of Conway's Game of Life
' * If a cell / space is empty, and surrounded by 2 or 3 organisms,
' a new organism is born on that space.
' * If a cell is occupied by an organism
' - If the organism has 2 or 3 neighbors, it survives to the next generation.
' - If the organism only has 1 or no neighbors, it dies of loneliness.
' - If the organism has 4 or more neighbors, it dies of overcrowding.
' * Statistics are displayed at the top:
' - current generation #
' - grand total of all organisms ever born / died
' - running total of organisms born & died in the current generation
' - current population
' * The simulation proceeds at 2 generations per second
' - To speed up the simulation, press up or right or + or page up
' - To slow down the simulation, press down or left or - or page down
' * Press the spacebar to pause the simulation, press it again to continue.
' * Press Escape to exit the current simulation.
' * The simulation exits when no organisms are alive or the user presses Escape.
' 6. The final statistics for the simulation are displayed:
' - The final generation number reached
' - Grand total organisms born/died for all generations.
' - Number of births/deaths in the last generation.
' - Final population.
' 7. Select whether to play again. If you choose "y", continue back at 1.
' -----------------------------------------------------------------------------
' Patterns
' -----------------------------------------------------------------------------
' Certain patterns are known to remain stable, repeat / oscillate,
' eventually die, or "move" with each generation ("spaceships").
' Many of these have popular names. Here are the main known patterns:
' -----------------------------------------------------------------------------
' TO DO
' -----------------------------------------------------------------------------
' * add macro keys to editor to automatically draw given patterns at the cursor position
' * add option to select how many generations organisms live before dying of old age
' * option detect when the world is stuck in an endlessly repeating pattern (upto n frames) and exit
' * bigger 32-bit hires screen, more cells
' * show statistics on how many survived to what age, cause of death, etc.
' * save/playback history of a world
' * editor ability to save / load a given generation or start pattern
' * pause at any generation and edit or step back/forward
' * add keyboard option back to editor
' -----------------------------------------------------------------------------
' BEYOND SIMPLE CONWAY
' -----------------------------------------------------------------------------
' Future challenge = expand to other types of organisms, environment,
' ecosystem, evolution?
'
' Including parameters for
' * food
' * different species or creature types that make up a food chain
' - animals vs plants vs microscopic life
' - predators vs prey
' - parasites
' - algae, plankton
' - plants drop seeds to reproduce, need water, seek light
' - single cell creatures divide to reproduce
' - complex animals mate to reproduce
' - larger animals eat smaller / simpler
' * attributes
' - fuel / energy
' - health / "hit points"
' - strength
' - speed
' - eyesight or other senses
' - (attributes where a high score balances out by making another attribute low)
' * evolving behavior
' * reproduction passes on traits / mutations (simple genetics)
' * weather
' * terrain
' * excretion of waste / disease
' * ecosystem
' * mating behavior / selection / competition
' * track an individual organism's DNA or "heritage"
Sub Liff
' DECLARE VARIABLES
Dim RoutineName As String: RoutineName = "Liff"
ReDim org%(0, 0, 0) ' array(column, row, generation)
Dim popu As Long
Dim a$
Dim r$
Dim iCount As Long
Dim ax, ay As Integer
Dim axOld, ayOld As Integer
Dim MinCol, MaxCol, MinRow, MaxRow As Integer
Dim MaxOrgs As Long
Dim k$
Dim gen As Long
Dim sLine As String
Dim CountPos As Integer
Dim born As Long
Dim died As Long
Dim lived As Long
Dim gone As Long
Dim family As Long
Dim North As Integer
Dim South As Integer
Dim East As Integer
Dim West As Integer
Dim age As Integer
Dim speed As Long
Dim bLeftClick As Integer
Dim bRightClick As Integer
Dim bOldLeftClick As Integer
Dim bOldRightClick As Integer
Dim arrKeyState(0 To 512) As Integer
Dim bAdded As Integer
Dim MaxAge As Integer
Dim reason$
' MAIN LOOP
Do
' INITIALIZE
Randomize Timer ' always put this at the start of a program that uses random numbers
MinRow = 1
MaxRow = _Height - 2 ' # of rows available (minus 2 rows which we use to show instructions)
MinCol = 1
MaxCol = _Width ' # of columns on the screen
ReDim org%(MinCol To MaxCol, MinRow To MaxRow, 1 To 2) ' set size of array
MaxOrgs = MaxCol * MaxRow ' what's the most # of organisms that can fit on the screen?
bLeftClick = _FALSE: bOldLeftClick = _FALSE
bRightClick = _FALSE: bOldRightClick = _FALSE
For iCount = LBound(arrKeyState) To UBound(arrKeyState)
arrKeyState(iCount) = _FALSE
Next iCount
reason$ = "TBD"
' SHOW TITLE
Cls , cBlackT ' clear screen and make it black
Color cLtGreenT, cBlackT ' set print color to light green on black
Print
Print " # ### ### ###"
Print " # # # #"
Print " # # ## ###"
Print " # # # #"
Print " ### ### # ###"
Print
Color cWhiteT, cBlackT ' set print color to white on black
' ASK USER TO ENTER PREFERENCES...
' PLACE RANDOMLY?
Do
Input "Allow organisms to age (y/n)"; a$
a$ = _Trim$(a$) ' remove extra spaces
a$ = LCase$(a$) ' force to lowercase
If a$ <> "y" And a$ <> "n" Then
Print "*** Please type y or n ***"
End If
Loop Until a$ = "y" Or a$ = "n"
If a$ = "y" Then MaxAge = 5 Else MaxAge = 1
' PLACE RANDOMLY?
Do
Input "Place the organisms randomly (y/n)"; r$
r$ = _Trim$(r$) ' remove extra spaces
r$ = LCase$(r$) ' force to lowercase
If r$ <> "y" And r$ <> "n" Then
Print "*** Please type y or n ***"
End If
Loop Until r$ = "y" Or r$ = "n"
' CLEAR KEYBOARD BUFFER
_KeyClear: _Delay 1
' IF RANDOMLY, THEN HOW MANY?
If r$ = "y" Then
Do
Print "How many organisms (1-" + _ToStr$(MaxOrgs) + ", or 0 for random)"
Input popu
If popu >= 1 Or popu <= MaxOrgs Then
' User selected a valid number
Exit Do ' stop asking (exit the do loop)
ElseIf popu = 0 Then
' Select a random number of organisms to make
popu = RandomNumber%(1, MaxOrgs)
Else
' Value is not valid, let the user know and keep asking
Print "*** Value out of range. Type a number 1-" + _ToStr$(MaxOrgs) + ". ***"
End If
Loop
Print
Print "Simulation will proceed with " + _ToStr$(popu) + " organisms."
Print
End If
' INITIALIZE ORGANISM ARAY
For ay = MinRow To MaxRow
For ax = MinCol To MaxCol
org%(ax, ay, 2) = 0 ' 2 is the next generation
Next ax
Next ay
' PLACE ORGANISMS
Cls
If r$ = "y" Then
' PLACE EACH ORGANISM RANDOMLY...
For iCount = 1 To popu
bAdded = PlaceRandomOrganism%(org%(), 2, MaxAge)
Next iCount
ElseIf r$ = "n" Then
' MANUALLY PLACE ORGANISMS...
' SHOW INSTRUCTIONS
Color cYellowT, cBlackT ' set print color to yellow on black
sLine = "Mouse selects location. Left click & right click to add/remove organisms."
Locate 1, 1: Print sLine;
sLine = "Press R to add randomly. Escape starts simulation. Population: "
Locate 2, 1: Print sLine;
CountPos = Len(sLine) + 1
' SHOW SCREEN AS A GRID TO HELP PLACEMENT
For ay = MinRow To MaxRow
For ax = MinCol To MaxCol
DrawOrganism org%(), ax, ay, 2, GetBgColor%(ax, ay), GetBgColor%(ax, ay), MaxAge
Next ax
Next ay
' RESET COUNT
popu = 0 ' no organisms placed yet
' PLACE CURSOR AT TOP LEFT
ax = MinCol: axOld = ax ' MaxCol
ay = MinRow: ayOld = ay ' MaxRow
' HIDE MOUSE POINTER
_MouseHide
' LOOP UNTIL USER HAS FINISH PLACING ORGANISMS
' array and mouse coordinates (ax, ay, axOld, ayOld) are 1-based
' drawing on screen starting at row 3, so ay+2
Do
' ERASE OLD
If axOld <> ax Or ayOld <> ay Then
DrawOrganism org%(), axOld, ayOld, 2, cGreenT, GetBgColor%(axOld, ayOld), MaxAge
End If
' Draw cursor at current location
DrawOrganism org%(), ax, ay, 2, GetBgColor%(ax, ay), cGreenT, MaxAge
' RESET OLD
axOld = ax
ayOld = ay
' READ MOUSE
Do While _MouseInput: Loop
ax = _MouseX
ay = _MouseY
bLeftClick = _MouseButton(1)
bRightClick = _MouseButton(2)
' VERSION FOR HI-RES SCREEN:
'ax = (_MouseX \ _FontWidth) * _FontWidth
'ay = (_MouseY \ _FontHeight) * _FontHeight
' CHECK BOUNDARIES
If ax < MinCol Then ax = MinCol Else If ax > MaxCol Then ax = MaxCol
If ay < MinRow Then ay = MinRow Else If ay > MaxRow Then ay = MaxRow
'If ax < 1 Then ax = 1 Else If ax > _Width Then ax = _Width
'If ay < 1 Then ay = 1 Else If ay > _Height Then ay = _Height
' DID THEY CLICK?
If bLeftClick Then
If bOldLeftClick = _FALSE Then
If org%(ax, ay, 2) = 0 Then popu = popu + 1
org%(ax, ay, 2) = org%(ax, ay, 2) + 1
If org%(ax, ay, 2) > MaxAge Then org%(ax, ay, 2) = 1
bOldLeftClick = _TRUE
End If
Else
bOldLeftClick = _FALSE
End If
If bRightClick Then
If bOldRightClick = _FALSE Then
If org%(ax, ay, 2) > 0 Then popu = popu - 1
org%(ax, ay, 2) = 0
bOldRightClick = _TRUE
End If
Else
bOldRightClick = _FALSE
End If
' Read keyboard
While _DeviceInput(1): Wend ' clear and update the keyboard buffer
' DON'T ACCEPT ANY MORE INPUT UNTIL THE LAST PRESSED KEY IS RELEASED
If _Button(KeyCode_R) = _TRUE Then
If arrKeyState(KeyCode_R) = _FALSE Then
arrKeyState(KeyCode_R) = _TRUE
' TRY TO RANDOMLY PLACE AN ORGANISM
If PlaceRandomOrganism(org%(), 2, MaxAge) = _TRUE Then
popu = popu + 1
Else
' PlaceRandomOrganism returned _FALSE
' so we are full, exit edit mode
Exit Do
End If
End If
Else
arrKeyState(KeyCode_R) = _FALSE
End If
' Check which keys were pressed
If _Button(KeyCode_Escape) = _TRUE Then
' Exit edit mode
Exit Do
End If
' SHOW POPULATION
Color cLtGreenT, cBlackT
Locate 2, CountPos: Print _ToStr$(popu) + " ";
' Govern speed of loop to 60 frames per second:
_Limit 60
Loop Until _KeyDown(27) ' escape key exit
' RESTORE MOUSE
_MouseShow "default": _Delay 0.5
' CLEAR KEYBOARD BUFFER
_KeyClear
End If
' THE CYCLE OF LIFE
speed = 2
gen = 0
lived = popu ' total that ever lived
gone = 0 ' total that have ever died
Do
Cls
gen = gen + 1 ' INCREASE GENERATION
' SHOW GENERATION
Color cYellowT, cBlackT
Locate 1, 1: Print "Generation: " + _ToStr$(gen);
' SHOW TOTAL THAT EVER LIVED
Color cLtGreenT, cBlackT
Locate 1, 25: Print "Total ever born: " + _ToStr$(lived);
' SHOW TOTAL THAT EVER DIED
Color cLtGrayT, cBlackT
Locate 1, 50: Print "Total ever died: " + _ToStr$(gone);
' SHOW BIRTHS
Color cCyanT, cBlackT
Locate 2, 1: Print "Births: " + _ToStr$(born) + " ";
' SHOW DEATHS
Color cPurpleT, cBlackT
Locate 2, 25: Print "Deaths: " + _ToStr$(died) + " ";
' SHOW POPULATION
Color cLtGreenT, cBlackT
Locate 2, 50: Print "Population: " + _ToStr$(popu) + " ";
' RESET THIS GENERATION'S STATISTICS
born = 0
died = 0
' SETUP FOR NEXT ROUND
For ay = MinRow To MaxRow
For ax = MinCol To MaxCol
' COPY NEXT GENERATION TO CURRENT
org%(ax, ay, 1) = org%(ax, ay, 2)
' AND DRAW THE NEXT ORGANISM
DrawOrganism org%(), ax, ay, 1, cGreenT, cBlackT, MaxAge
Next ax
Next ay
' BORN, LIVE, DIE
For ay = MinRow To MaxRow
For ax = MinCol To MaxCol
' COUNT NEIGHBORS
family = 0
' GET NEIGHBORS' POSITIONS
' WRAP AROUND THE EDGES (THE WORLD IS ROUND!)
If ax = MinCol Then
West = MaxCol
East = ax + 1
ElseIf ax = MaxCol Then
West = ax - 1
East = MinCol
Else
West = ax - 1
East = ax + 1
End If
If ay = MinRow Then
North = MaxRow
South = ay + 1
ElseIf ay = MaxRow Then
North = ay - 1
South = MinRow
Else
North = ay - 1
South = ay + 1
End If
' Check NW neighbor
If org%(West, North, 1) > 0 Then family = family + 1
' Check N neighbor
If org%(ax, North, 1) > 0 Then family = family + 1
' Check NE neighbor
If org%(East, North, 1) > 0 Then family = family + 1
' Check W neighbor
If org%(West, ay, 1) > 0 Then family = family + 1
' Check E neighbor
If org%(East, ay, 1) > 0 Then family = family + 1
' Check SW neighbor
If org%(West, South, 1) > 0 Then family = family + 1
' Check S neighbor
If org%(ax, South, 1) > 0 Then family = family + 1
' Check SE neighbor
If org%(East, South, 1) > 0 Then family = family + 1
' SEE WHO LIVES / DIES / IS BORN
' look at current generation (x, y, 1)
' to update next generation (x, y, 2)
If org%(ax, ay, 1) = 0 Then
' REPRODUCTION?
If family = 3 Then
' BIRTH
org%(ax, ay, 2) = 1
popu = popu + 1 ' ** POPULATION INCREASES BY 1 **
born = born + 1 ' INCREASE COUNT BORN THIS GENERATION
lived = lived + 1 ' INCREASE COUNT OF ALL ORGANISMS EVER BORN
End If
ElseIf org%(ax, ay, 1) > 0 Then
' LIVE OR DIE?
If family < 2 Then
' DIED OF LONELINESS
org%(ax, ay, 2) = 0
popu = popu - 1 ' ** POPULATION DECREASES BY 1 **
died = died + 1 ' INCREASE COUNT DIED THIS GENERATION
gone = gone + 1 ' INCREASE COUNT OF ALL ORGANISMS EVER DIED
ElseIf family > 3 Then
' DIED OF OVERCROWDING
org%(ax, ay, 2) = 0
popu = popu - 1 ' ** POPULATION DECREASES BY 1 **
died = died + 1 ' INCREASE COUNT DIED THIS GENERATION
gone = gone + 1 ' INCREASE COUNT OF ALL ORGANISMS EVER DIED
ElseIf family = 2 Or family = 3 Then
' LIFE GOES ON
If MaxAge > 1 Then
' AGING! 1 = newborn, 5 = maximum age
org%(ax, ay, 2) = org%(ax, ay, 2) + 1
' DIED OF OLD AGE
If org%(ax, ay, 2) > 5 Then
' DIED OF OLD AGE
org%(ax, ay, 2) = 0
popu = popu - 1 ' ** POPULATION DECREASES BY 1 **
died = died + 1 ' INCREASE COUNT DIED THIS GENERATION
gone = gone + 1 ' INCREASE COUNT OF ALL ORGANISMS EVER DIED
End If
End If
End If
End If
' REFRESH SCREEN
_Display
Next ax
Next ay
' RE-COUNT POPULATION (BRUTE FORCE METHOD, SINCE NORMAL METHODS DON'T SEEM TO WORK WHEN AGING IS ENABLED)
popu = 0
For ay = MinRow To MaxRow
For ax = MinCol To MaxCol
If org%(ax, ay, 2) > 0 Then
popu = popu + 1
End If
Next ax
Next ay
' If population falls to zero then exit
If popu < 1 Then reason$ = "no organisms survived": Exit Do
' PROCESS KEYBOARD INPUT
While _DeviceInput(1): Wend ' clear and update the keyboard buffer
If _Button(KeyCode_Escape) Then
' ESCAPE = EXIT
reason$ = "cancelled": Exit Do
ElseIf _Button(KeyCode_Spacebar) Then
' SPACEBAR = PAUSE
Color cBlackT, cWhiteT
Locate 1, 1: Print "PAUSED - PRESS ANY KEY TO CONTINUE";
_Display
_KeyClear: _Delay 1
Sleep
_KeyClear: _Delay 1
Color cWhiteT, cBlackT
Locate 1, 1: Print " ";
ElseIf _Button(KeyCode_Equal) Or _Button(KeyCode_Right) Or _Button(KeyCode_Up) Or _Button(KeyCode_PgUp) Then
' + OR RIGHT ARROW OR UP ARROW OR PAGE UP = INCREASE SPEED
speed = speed + 1
If speed > 1000 Then speed = 1000
ElseIf _Button(KeyCode_Minus) Or _Button(KeyCode_Left) Or _Button(KeyCode_Down) Or _Button(KeyCode_PgDn) Then
' - OR LEFT ARROW OR DOWN ARROW OR PAGE DOWN = SLOW DOWN
speed = speed - 1
If speed < 1 Then speed = 1
End If
' CLEAR KEYBOARD BUFFER
_KeyClear
' increment generation counter
gen = gen + 1
' REFRESH SCREEN
_Display
' LIMIT TO 2 GENERATIONS / SECOND
_Limit speed
Loop
' RESTORE NORMAL SCREEN REFRESH
_AutoDisplay
' CLEAR KEYBOARD BUFFER
_KeyClear: _Delay 1
' PLAY AGAIN?
Cls
Color cWhiteT, cBlackT
Print "SIMULATION OVER (" + reason$ + ")."
Print
' SHOW FINAL STATS
Print "Final statistics:"
Color cYellowT, cBlackT: Print "Generation : " + _ToStr$(gen)
Color cLtGreenT, cBlackT: Print "Total ever born : " + _ToStr$(lived)
Color cLtGrayT, cBlackT: Print "Total ever died : " + _ToStr$(gone)
Color cCyanT, cBlackT: Print "Last generation births: " + _ToStr$(born)
Color cPurpleT, cBlackT: Print "Last generation Deaths: " + _ToStr$(died)
Color cLtGreenT, cBlackT: Print "Final population : " + _ToStr$(popu)
Print
Color cWhiteT, cBlackT
Do
Input "Start over and try again (y/n)"; a$
a$ = _Trim$(a$) ' remove extra spaces
a$ = LCase$(a$) ' force to lowercase
If a$ <> "y" And a$ <> "n" Then
Print "*** Please type y or n ***"
End If
Loop Until a$ = "y" Or a$ = "n"
If a$ = "n" Then Exit Do
Function GetBgColor% (ax%, ay%)
If IsOdd%(ay%) Then
If IsOdd%(ax%) Then
GetBgColor% = cBlackT
Else
GetBgColor% = cGrayT
End If
Else
If IsOdd%(ax%) Then
GetBgColor% = cGrayT
Else
GetBgColor% = cBlackT
End If
End If
End Function ' GetBgColor%
' /////////////////////////////////////////////////////////////////////////////
' Returns _TRUE if an organism was placed
' only should return _FALSE if no more empty spaces
Function PlaceRandomOrganism% (org%(), gen%, MaxAge%)
Dim bResult As Integer
Dim MinCol, MaxCol As Integer
Dim MinRow, MaxRow As Integer
Dim age As Integer
Dim ax, ay As Integer
Dim dx, dy As Integer
Dim iCount As Integer
Dim iMax As Integer
' Calculate maximum possible count
dx = 1 - MinCol
dy = 1 - MinRow
iMax = (MaxCol + dx) * (MaxRow + dy)
' Count # currently present
iCount = 0
For ax = MinCol To MaxCol
For ay = MinRow To MaxRow
If org%(ax, ay, gen%) > 0 Then iCount = iCount + 1
Next ay
Next ax
' If room for more, place one randomly
bResult = (iCount < iMax)
If bResult = _TRUE Then
' KEEP LOOKING FOR A RANDOM UNOCCUPIED LOCATION
Do
ax = RandomNumber%(MinCol, MaxCol) ' SELECT A RANDOM COLUMN
ay = RandomNumber%(MinRow, MaxRow) ' SELECT A RANDOM ROW
' MAKE SURE IT'S NOT ALREADY OCCUPIED
If org%(ax, ay, gen%) = 0 Then
age = RandomNumber%(1, MaxAge%)
org%(ax, ay, gen%) = age
DrawOrganism org%(), ax, ay, gen%, cGreenT, cBlackT, MaxAge%
Exit Do ' break out of loop and move on to the next organism
End If
Loop
End If
' Return result
PlaceRandomOrganism = bResult
End Function ' PlaceRandomOrganism
Function GetOrganism$ (age%, MaxAge%)
Dim org$
If MaxAge% > 1 Then
Select Case age%
Case 1:
org$ = "."
Case 2:
org$ = "o"
Case 3:
org$ = "O"
Case 4:
org$ = "0"
Case 5:
org$ = "@"
Case Else:
org$ = " "
End Select
Else
If age% > 0 Then
'org$ = "O"
org$ = Chr$(177)
Else
org$ = " "
End If
End If
GetOrganism$ = org$
End Function ' GetOrganism
' /////////////////////////////////////////////////////////////////////////////
' Generate random value between Min and Max inclusive.
' Make sure you put Randomize Timer at the start of your program
Function RandomNumber% (Min%, Max%)
Dim NumSpread%
NumSpread% = (Max% - Min%) + 1
RandomNumber% = Int(Rnd * NumSpread%) + Min% ' GET RANDOM # BETWEEN Max% AND Min%
End Function ' RandomNumber%
' /////////////////////////////////////////////////////////////////////////////
' Use to pretty print _TRUE and _FALSE values.
Function TrueFalse$ (myValue%)
TrueFalse$ = _IIf(myValue%, "_TRUE", "_FALSE")
End Function ' TrueFalse$
' /////////////////////////////////////////////////////////////////////////////
' Returns _TRUE if number n is even
' https://slaystudy.com/qbasic-program-to-check-if-number-is-even-or-odd/
Function IsEven% (n)
If n Mod 2 = 0 Then
IsEven% = _TRUE
Else
IsEven% = _FALSE
End If
End Function ' IsEven%
' /////////////////////////////////////////////////////////////////////////////
' Returns _TRUE if number n is odd
' https://slaystudy.com/qbasic-program-to-check-if-number-is-even-or-odd/
Function IsOdd% (n)
If n Mod 2 = 1 Then
IsOdd% = _TRUE
Else
IsOdd% = _FALSE
End If
End Function ' IsOdd%
Original post:
Back in high school I had a computer class where one of the assignments was to recreate the famous computer simulation Life.
I added a feature in my version where organisms grow with each generation, where they die of old age after 5 generations.
Here is the basic program updated for QB64PE.
NOTES:
There is one bug: we track the current population in a variable popu%, which increases by 1 when an organism is born and decreases by 1 when one dies, but for some reason the value goes negative or really high.
We tried limiting reproduction to only organisms of mating age (2-3, 2-4, etc.) but the population always died out in just a few generations. So this version uses the original rule where a new organism is born in any space surrounded by exactly 3 organisms.
It would be interesting to expand this to simulate other aspects of life such as
food / natural resources
different species (animals vs plants, predators vs prey vs parasites)
evolving behavior
rules around mating (age, competition for mates, etc.)
reproduction passes on traits / mutations
environment (terrain, weather)
excretion of waste / disease
ecosystem
Enjoy
Code: (Select All)
' LIFF v1.00
' BY SOFTINTHEHEADWARE
' A VERSION OF LIFE BY JOHN CONWAY
' This version has aging: organisms die after they are 5 generations old.
' Bugs to fix
' * for some reason the population counter doesn't work
' it drops below zero and gets really high, not sure why
' Other to do:
' * bigger screen, more cells
' * show statistics on how many survived to what age, cause of death, etc.
' * save/playback history of a world
' * What other parameters can we introduce?
' - mating: we tried only letting them mate if surrounded by others age 2-4,
' but they always seemed to die faster than they were born?
' - food
' - different species (animals vs plants, predators vs prey vs parasites)
' - evolving behavior
' - reproduction passes on traits / mutations
' - weather
' - terrain
' - excretion of waste / disease
' - ecosystem
Sub Life
' DECLARE VARIABLES
ReDim org%(0, 0)
Dim popu%
Dim r$
Dim iCount%
Dim x%
Dim y%
Dim oldX%
Dim oldY%
Dim MinCol%, MaxCol%, MinRow%, MaxRow%
Dim MaxOrgs%
Dim LastKey%
Dim k$
Dim KeyDelayCount%
Dim DX%, DY%
Dim gen&
Dim sLine$
Dim CountPos%
Dim born%
Dim died%
Dim lived&
Dim gone&
Dim family%
Dim mates%
Dim px%
Dim N%
Dim S%
Dim E%
Dim W%
Dim age%
Dim speed%
' INITIALIZE
Randomize Timer ' always put this at the start of a program that uses random numbers
MinRow% = 1
MaxRow% = _Height - 2 ' # of rows available (minus 2 rows which we use to show instructions)
MinCol% = 1
MaxCol% = _Width ' # of columns on the screen
ReDim org%(MinCol% To MaxCol%, MinRow% To MaxRow%) ' set size of array
MaxOrgs% = MaxCol% * MaxRow% ' what's the most # of organisms that can fit on the screen?
' SHOW TITLE
Cls , cBlackT ' clear screen and make it black
Color cLtGreenT, cBlackT ' set print color to light green on black
Print
Print " # ### ### ###"
Print " # # # #"
Print " # # ## ###"
Print " # # # #"
Print " ### ### # ###"
Print
Color cWhiteT, cBlackT ' set print color to white on black
' ASK USER TO ENTER PREFERENCES...
' PLACE RANDOMLY?
Do
Input "Place the organisms randomly (y/n)"; r$
r$ = _Trim$(r$) ' remove extra spaces
r$ = LCase$(r$) ' force to lowercase
If r$ <> "y" And r$ <> "n" Then
Print "*** Please type y or n ***"
End If
Loop Until r$ = "y" Or r$ = "n"
' CLEAR KEYBOARD BUFFER
_KeyClear: _Delay 1
' IF RANDOMLY, THEN HOW MANY?
If r$ = "y" Then
Do
Print "How many organisms (1-" + _ToStr$(MaxOrgs%) + ", or 0 for random)"
Input popu%
If popu% >= 1 And popu% <= MaxOrgs% Then
' User selected a valid number
Exit Do ' stop asking (exit the do loop)
ElseIf popu% = 0 Then
' Select a random number of organisms to make
popu% = RandomNumber%(1, MaxOrgs%)
Else
' Value is not valid, let the user know and keep asking
Print "*** Value out of range. Type a number 1-" + _ToStr$(MaxOrgs%) + ". ***"
End If
Loop
Print
Print "Simulation will proceed with " + _ToStr$(popu%) + " organisms."
Print
End If
' INITIALIZE ORGANISM ARAY
For y% = MinRow% To MaxRow%
For x% = MinCol% To MaxCol%
org%(x%, y%) = 0
Next x%
Next y%
' PLACE ORGANISMS
Cls
If r$ = "y" Then
' PLACE EACH ORGANISM RANDOMLY
For iCount% = 1 To popu%
' TRY TO FIND A RANDOM UNOCCUPIED LOCATION
Do
' SELECT A RANDOM COLUMN
x% = RandomNumber%(MinCol%, MaxCol%)
' SELECT A RANDOM ROW
y% = RandomNumber%(MinRow%, MaxRow%)
' MAKE SURE IT'S NOT ALREADY OCCUPIED
If org%(x%, y%) = 0 Then
age% = RandomNumber%(1, 5)
org%(x%, y%) = age%
'org%(x%, y%) = 1
Exit Do ' break out of loop and move on to the next organism
End If
Loop
Next iCount%
' MANUALLY PLACE ORGANISMS?
ElseIf r$ = "n" Then
' SHOW INSTRUCTIONS
Color cYellowT, cBlackT ' set print color to yellow on black
sLine$ = "Use arrow keys to move cursor. Press Enter to add/remove organism."
Locate 1, 1: Print sLine$;
sLine$ = "Press Escape to quit adding and start simulation. Population: "
Locate 2, 1: Print sLine$;
CountPos% = Len(sLine$) + 1
' PLACE CURSOR AT TOP LEFT
x% = 1: oldX% = x%: DX% = 0
y% = 1: oldY% = y%: DY% = 0
' NO KEYS PRESSED YET
LastKey% = 0
' LOOP UNTIL USER HAS FINISH PLACING ORGANISMS
Do
' Draw cursor at current location
DrawCursor org%(), x%, y%
' Read keyboard
While _DeviceInput(1): Wend ' clear and update the keyboard buffer
' DON'T ACCEPT ANY MORE INPUT UNTIL THE LAST PRESSED KEY IS RELEASED
If LastKey% <> 0 Then
If _Button(LastKey%) = FALSE Then
LastKey% = 0
KeyDelayCount% = 0
Else
KeyDelayCount% = KeyDelayCount% + 1
If KeyDelayCount% > cKeyDelay Then
LastKey% = 0
KeyDelayCount% = 0
End If
End If
End If
' Check which keys were pressed
If _Button(KeyCode_Escape) And LastKey% <> KeyCode_Escape Then
' Escape
LastKey% = KeyCode_Escape
' Stop placing organisms
Exit Do
ElseIf _Button(KeyCode_Up) And LastKey% <> KeyCode_Up Then
' Up arrow
LastKey% = KeyCode_Up
' Move if not turning
If DX% = 0 Then
' Move up one row
y% = y% - 1
' If they moved off the edge, wrap them around to the other side
If y% < MinRow% Then
y% = MaxRow%
x% = x% - 1: If x% < MinCol% Then x% = MaxCol%
End If
End If
DY% = -1: DX% = 0
ElseIf _Button(KeyCode_Down) And LastKey% <> KeyCode_Down Then
' Down arrow
LastKey% = KeyCode_Down
' Move if not turning
If DX% = 0 Then
' Move down one row
y% = y% + 1
' If they moved off the edge, wrap them around to the other side
If y% > MaxRow% Then
y% = MinRow%
x% = x% + 1: If x% > MaxCol% Then x% = MinCol%
End If
End If
DY% = 1: DX% = 0
ElseIf _Button(KeyCode_Left) And LastKey% <> KeyCode_Left Then
' Left arrow
LastKey% = KeyCode_Left
' Move if not turning
If DY% = 0 Then
' Move left one column
x% = x% - 1
' If they moved off the edge, wrap them around to the other side
If x% < MinCol% Then
x% = MaxCol%
y% = y% - 1: If y% < MinRow% Then y% = MaxRow%
End If
End If
DX% = -1: DY% = 0
ElseIf _Button(KeyCode_Right) And LastKey% <> KeyCode_Right Then
' Right arrow
LastKey% = KeyCode_Right
' Move if not turning
If DY% = 0 Then
' Move right one column
x% = x% + 1
' If they moved off the edge, wrap them around to the other side
If x% > MaxCol% Then
x% = MinCol%
y% = y% + 1: If y% > MaxRow% Then y% = MinRow%
End If
End If
DX% = 1: DY% = 0
ElseIf _Button(KeyCode_Home) And LastKey% <> KeyCode_Home Then
' Home key
LastKey% = KeyCode_Home
' Jump to the beginning of the current row
x% = MinCol%
ElseIf _Button(KeyCode_End) And LastKey% <> KeyCode_End Then
' End key
LastKey% = KeyCode_End
' Jump to the end of the current row
x% = MaxCol%
ElseIf _Button(KeyCode_PgUp) And LastKey% <> KeyCode_PgUp Then
' Page Up key
LastKey% = KeyCode_PgUp
' Move to the top of the current column
y% = MinRow%
ElseIf _Button(KeyCode_PgDn) And LastKey% <> KeyCode_PgDn Then
' Page Down key
LastKey% = KeyCode_PgDn
' Jump to the bottom of the current column
y% = MaxRow%
DrawOrganism org%(), oldX%, oldY%
ElseIf _Button(KeyCode_Enter) And LastKey% <> KeyCode_Enter Then
' Enter
LastKey% = KeyCode_Enter
' Place an organism here (or remove if there is one there already)
If org%(x%, y%) = 0 Then
org%(x%, y%) = 1 ' set current location to have an organism
popu% = popu% + 1 ' Increase the count
' If we have placed the maximum # of organisms, then exit
If popu% >= MaxOrgs% Then
Exit Do
End If
Else
org%(x%, y%) = 0 ' set current locaton have NO organisms
popu% = popu% - 1 ' Decrease the count
' # of organisms should never fall below zero, but make sure just in case
If popu% < 0 Then
popu% = 0
End If
End If
' Show change in population
Locate 2, CountPos%
Color cYellowT, cBlackT ' set print color to yellow on black
Print _ToStr$(popu%);
' *****************************************************************************
' SOME FANCY CODE TO
' MOVE ONE SPACE IN THE LAST DIRECTION THEY WERE GOING
If DY% = -1 Then
' Move up one row
y% = y% - 1
' If they moved off the edge, wrap them around to the other side
If y% < MinRow% Then
y% = MaxRow%
x% = x% - 1: If x% < MinCol% Then x% = MaxCol%
End If
ElseIf DY% = 1 Then
' Move down one row
y% = y% + 1
' If they moved off the edge, wrap them around to the other side
If y% > MaxRow% Then
y% = MinRow%
x% = x% + 1: If x% > MaxCol% Then x% = MinCol%
End If
ElseIf DX% = -1 Then
' Move left one column
x% = x% - 1
' If they moved off the edge, wrap them around to the other side
If x% < MinCol% Then
x% = MaxCol%
y% = y% - 1: If y% < MinRow% Then y% = MaxRow%
End If
Else
DX% = 1
' Move right one column
x% = x% + 1
' If they moved off the edge, wrap them around to the other side
If x% > MaxCol% Then
x% = MinCol%
y% = y% + 1: If y% > MaxRow% Then y% = MinRow%
End If
End If
' END FANCY CODE
' *****************************************************************************
End If
' CLEAR KEYBOARD BUFFER
_KeyClear
' If user has moved then erase cursor
If x% <> oldX% Or y% <> oldY% Then
DrawOrganism org%(), oldX%, oldY%
End If
' Reset previous location
oldX% = x%
oldY% = y%
' Govern speed of loop to 60 frames per second:
_Limit 60
Loop
End If
' THE CYCLE OF LIFE
speed% = 2
gen& = 0
lived& = popu% ' total that ever lived
gone& = 0 ' total that have ever died
Do
Cls
gen& = gen& + 1 ' INCREASE GENERATION
' SHOW GENERATION
Color cYellowT, cBlackT
Locate 1, 1: Print "Generation: " + _ToStr$(gen&);
' SHOW TOTAL THAT EVER LIVED
Color cLtGreenT, cBlackT
Locate 1, 25: Print "Total ever born: " + _ToStr$(lived&);
' SHOW TOTAL THAT EVER DIED
Color cLtGrayT, cBlackT
Locate 1, 50: Print "Total ever died: " + _ToStr$(gone&);
' SHOW BIRTHS
Color cCyanT, cBlackT
Locate 2, 1: Print "Births: " + _ToStr$(born%) + " ";
' SHOW DEATHS
Color cPurpleT, cBlackT
Locate 2, 25: Print "Deaths: " + _ToStr$(died%) + " ";
' SHOW POPULATION
Color cLtGreenT, cBlackT
Locate 2, 50: Print "Population: " + _ToStr$(popu%) + " ";
' DRAW THE RACE
For y% = MinRow% To MaxRow%
For x% = MinCol% To MaxCol%
DrawOrganism org%(), x%, y%
Next x%
Next y%
' BORN, LIVE, DIE
For y% = MinRow% To MaxRow%
For x% = MinCol% To MaxCol%
' COUNT NEIGHBORS, MATES
family% = 0
mates% = 0 ' *** THIS DOESN'T SEEM TO WORK! THEY DIE FASTER THAN THEY REPRODUCE! ***
' GET NEIGHBORS' POSITIONS
' WRAP AROUND THE EDGES (THE WORLD IS ROUND!)
If x% = MinCol% Then
W% = MaxCol%
E% = x% + 1
ElseIf x% = MaxCol% Then
W% = x% - 1
E% = MinCol%
Else
W% = x% - 1
E% = x% + 1
End If
If y% = MinRow% Then
N% = MaxRow%
S% = y% + 1
ElseIf y% = MaxRow% Then
N% = y% - 1
S% = MinRow%
Else
N% = y% - 1
S% = y% + 1
End If
' NW
age% = org%(W%, N%)
If age% > 0 Then family% = family% + 1
If age% >= cMinMateAge And age% <= cMaxMateAge Then mates% = mates% + 1
' N
age% = org%(x%, N%)
If age% > 0 Then family% = family% + 1
If age% >= cMinMateAge And age% <= cMaxMateAge Then mates% = mates% + 1
' NE
age% = org%(E%, N%)
If age% > 0 Then family% = family% + 1
If age% >= cMinMateAge And age% <= cMaxMateAge Then mates% = mates% + 1
' W
age% = org%(W%, y%)
If age% > 0 Then family% = family% + 1
If age% >= cMinMateAge And age% <= cMaxMateAge Then mates% = mates% + 1
' E
age% = org%(E%, y%)
If age% > 0 Then family% = family% + 1
If age% >= cMinMateAge And age% <= cMaxMateAge Then mates% = mates% + 1
' SW
age% = org%(W%, S%)
If age% > 0 Then family% = family% + 1
If age% >= cMinMateAge And age% <= cMaxMateAge Then mates% = mates% + 1
' S
age% = org%(x%, S%)
If age% > 0 Then family% = family% + 1
If age% >= cMinMateAge And age% <= cMaxMateAge Then mates% = mates% + 1
' SE
age% = org%(E%, S%)
If age% > 0 Then family% = family% + 1
If age% >= cMinMateAge And age% <= cMaxMateAge Then mates% = mates% + 1
' SEE WHO LIVES / DIES / IS BORN
If org%(x%, y%) = 0 Then
' REPRODUCTION
'If mates% = 3 Then ' *** ONLY REPRODUCING WITH ELIGIBLE MATES HAS NOT WORKED...
If family% = 3 Then
' BIRTH
org%(x%, y%) = 1
born% = born% + 1
'TRY ADJUSTING AT END OF GENERATION: popu% = popu% + 1
lived& = lived& + 1
End If
ElseIf org%(x%, y%) > 0 Then
' LIVE OR DIE?
If family% < 2 Or family% > 3 Then
' DIED OF LONELINESS
org%(x%, y%) = 0
died% = died% + 1
'TRY ADJUSTING AT END OF GENERATION: popu% = popu% - 1
gone& = gone& + 1
ElseIf family% = 2 Or family% = 3 Then
' AGING!
' 1 = newborn, 5 = maximum age
org%(x%, y%) = org%(x%, y%) + 1
If org%(x%, y%) > 5 Then
' DIED OF OLD AGE
died% = died% + 1
'TRY ADJUSTING AT END OF GENERATION: popu% = popu% - 1
gone& = gone& + 1
End If
End If
End If
' REFRESH SCREEN
_Display
Next x%
Next y%
' ADJUST POPULATION <- this number gets out of control, not sure why
popu% = popu% + born%
popu% = popu% - died%
' PROCESS KEYBOARD INPUT
While _DeviceInput(1): Wend ' clear and update the keyboard buffer
If _Button(KeyCode_Escape) Then
' EXIT
Exit Do
ElseIf _Button(KeyCode_Spacebar) Then
' PAUSE
Color cBlackT, cWhiteT
Locate 1, 1: Print "PAUSED - PRESS ANY KEY TO CONTINUE";
_Display
_KeyClear: _Delay 1
Sleep
_KeyClear: _Delay 1
Color cWhiteT, cBlackT
Locate 1, 1: Print " ";
ElseIf _Button(KeyCode_Equal) Or _Button(KeyCode_Right) Or _Button(KeyCode_Up) Or _Button(KeyCode_PgUp) Then
' INCREASE SPEED
speed% = speed% + 1
If speed% > 1000 Then speed% = 1000
ElseIf _Button(KeyCode_Minus) Or _Button(KeyCode_Left) Or _Button(KeyCode_Down) Or _Button(KeyCode_PgDn) Then
' SLOW DOWN
speed% = speed% - 1
If speed% < 1 Then speed% = 1
End If
' CLEAR KEYBOARD BUFFER
_KeyClear
' increment generation counter
gen& = gen& + 1
' REFRESH SCREEN
_Display
' LIMIT TO 2 GENERATIONS / SECOND
_Limit speed%
Loop
Sub DrawCursor (org%(), x%, y%)
' If there is an organism there, show it
If org%(x%, y%) > 0 Then
Color cGreenT, cWhiteT ' set print color to green on white
Locate y% + 2, x%
'Print "O";
Print GetOrganism$(org%(x%, y%));
Else
Color cWhiteT, cWhiteT ' set print color to white on white
Locate y% + 2, x%
Print " ";
End If
End Sub ' DrawCursor
Sub DrawOrganism (org%(), x%, y%)
If x% >= LBound(org%, 1) And x% <= UBound(org%, 1) Then
If y% >= LBound(org%, 2) And y% <= UBound(org%, 2) Then
Locate y% + 2, x%
If org%(x%, y%) > 0 Then
Color cLtGreenT, cBlackT
'Print "O";
Print GetOrganism$(org%(x%, y%));
Else
Color cLtGreenT, cBlackT
Print " ";
End If
End If
End If
End Sub ' DrawOrganism
Function GetOrganism$ (age%)
Dim org$
Select Case age%
Case 1:
org$ = "."
Case 2:
org$ = "o"
Case 3:
org$ = "O"
Case 4:
org$ = "0"
Case 5:
org$ = "@"
Case Else:
org$ = ""
End Select ' SELECT CASE iDirection%
GetOrganism$ = org$
End Function ' GetOrganism
' /////////////////////////////////////////////////////////////////////////////
' Generate random value between Min and Max inclusive.
' Make sure you put Randomize Timer at the start of your program
Function RandomNumber% (Min%, Max%)
Dim NumSpread%
NumSpread% = (Max% - Min%) + 1
RandomNumber% = Int(Rnd * NumSpread%) + Min% ' GET RANDOM # BETWEEN Max% AND Min%
End Function ' RandomNumber%
Aurel presented this at another Discord, pretty cool! worked right out of the box.
Code: (Select All)
' Reference Aurel found this and it is pretty cool 2025-06-05 2025 I share with QB64pe
_Title "Schraf Brot (per Aurel 2025-06-05)" ' only line of code I added
w = 1280
h = 720
zoom = 3 / w
dmin = 0.06
Screen _NewImage(w, h, 32): _ScreenMove 0, 0 ' oh I need to move this too!
Cls
For a = 0 To w - 1
For b = 0 To 1.5 * h
x = (a - w) * zoom
y = (b - h) * zoom
i = 0
d = 100
Do
u = x * x
v = y * y
If u + v > 4.8 Or i > 30 Or d < dmin Then
Exit Do
End If
t = u - v
y = 2 * x * y + 0.156
x = t - 0.8
i = i + 1
n = Abs(u + v - 1)
If n < d Then d = n
Loop
If d < dmin Then
coul = 255 - Int(4000 * d)
If coul < 0 Then coul = 0
If coul > 255 Then coul = 255
x1 = a - w / 2
y1 = b - h / 2
x2 = w + w / 2 - 1 - a
y2 = h + h / 2 - b
Line (x1, y1)-(x1 + 1, y1 + 1), _RGB(coul, coul, 0)
Line (x2, y2)-(x2 + 1, y2 + 1), _RGB(coul, coul, 0)
End If
Next b
Next a
End
I have a folder called RecallHist containing several files with names like "ABC4, ABC6, POP1, POP6, AB1, BD3
and I need to delete those that start with POP (for example).
I've written this code, but the selection$ string is not correct - file is not found.
Code: (Select All)
Name$ = "POP"
Print "Name$ is "; Name$
NewHist:
k = _KeyHit
_Limit 30
If k <> 21248 Then GoTo NewHist ' wait for Delete key
selection$ = "RecallHist/" + Name$ + "?" ' <----------------------------------- this line is wrong - file is not being found
Print "selection$ is "; selection$
If _FileExists(selection$) Then
Kill selection$ ' delete files in RecallHist that start with POP plus any other char
Print "Killed"; selection$ ' deleted history files for this name
Else
Print "History still intact" ' not deleted
End If
I wrote this, with the help of B+, Steve, and others 4 1/2 years ago. Today I adjusted the size of the window to match on each side and slowed down the alarm beeps a little bit.
Edited: Also download the zip file which contains the LCD font needed for this and put it in the same folder.
Code: (Select All)
'Vacuum Fluorescent Display Time/Date and Alarm by SierraKen on Dec. 4, 2020.
'This is my first clock using a font.
'Added: Alarm Clock.
'Added: Made AM/PM to stop moving.
'Added: "8" background LCD shadows.
'Added: Uses new MONOSPACE LCD font that aligns everything perfectly.
'Added: _TRIM$ to fix hours.
'Make sure PinballChallengeDeluxe-ae6g.ttf is in the same directory as this program.
'Font found here: https://www.fontspace.com/category/monospaced,lcd
'Thanks to B+, Steve, and the others on the QB64 forum for your help!
'June 4, 2025 Update: Fixed window size and slowed down alarm.
Dim f As Long
Dim background As Long
_Title "Time and Date - (S)et Alarm"
clock& = _NewImage(475, 200, 32)
Screen clock&
start:
fontfile$ = "PinballChallengeDeluxe-ae6g.ttf"
f& = _LoadFont(fontfile$, 62, "MONOSPACE")
_Font f&
Color _RGB32(32, 64, 32), _RGB32(0, 0, 0, 10)
background& = _CopyImage(0)
Do
_Limit 50
_PutImage , background&
a$ = InKey$
If a$ = " " Or a$ = "s" Or a$ = "S" Or a$ = "a" Or a$ = "A" Then GoSub alarm:
t$ = Time$
hour$ = Left$(t$, 2)
h = Val(hour$)
If h > 11 Then pmam$ = "PM": ampm4 = 2
If h < 12 Then pmam$ = "AM": ampm4 = 1
If h > 12 Then h = h - 12: hour$ = _Trim$(Str$(h))
If h = 0 Then hour$ = "12": pmam$ = "AM": ampm4 = 1
minute$ = Mid$(t$, 4, 2)
m = Val(minute$)
second$ = Right$(t$, 2)
s = Val(second$)
Color _RGB32(127, 255, 127), _RGB32(0, 0, 0, 10)
If h < 10 And h > 0 Then hour$ = "0" + hour$
_PrintString (10, 10), hour$ + ":" + minute$ + ":" + second$
_PrintString (375, 10), pmam$
_PrintString (20, 125), Date$
If alarm = 1 Then
month2$ = Left$(Date$, 2)
month2 = Val(month2$)
day2$ = Mid$(Date$, 4, 2)
day2 = Val(day2$)
year2$ = Right$(Date$, 4)
year2 = Val(year2$)
If year = year2 And month = month2 And day = day2 And h = hour2 And m = minute2 And s = second2 And ampm3 = ampm4 Then
Do
For snd = 400 To 500 Step 25
Sound snd, .5
Next snd
_Delay .5
_Title "** Alarm ** Press Any Key To Stop"
Loop Until InKey$ <> ""
alarm = 0
_Title "Time and Date - (S)et Alarm"
GoTo noalarm:
End If
End If
noalarm:
_Display
Cls
Loop Until a$ = Chr$(27)
_Font 16
End
alarm:
_Title "Set Alarm Here"
_Font 16
Cls
year:
_FreeImage background&
Input "Year (example: 2020): ", year
If year < 2020 Or year <> Int(year) Then GoTo year:
month:
Input "Month (1-12):", month
If month < 1 Or month > 12 Or month <> Int(month) Then GoTo month:
day:
Input "Day (1-31): ", day
If day < 1 Or day > 31 Or day <> Int(day) Then GoTo day:
hour:
Input "Hour (1-12): ", hour2
If hour2 < 1 Or hour2 > 12 Or hour2 <> Int(hour2) Then GoTo hour:
timeofday:
Input "AM or PM: ", ampm2$
If Left$(ampm2$, 1) = "a" Or Left$(ampm2$, 1) = "A" Then ampm3 = 1: GoTo minute:
If Left$(ampm2$, 1) = "p" Or Left$(ampm2$, 1) = "P" Then ampm3 = 2: GoTo minute:
GoTo timeofday:
minute:
Input "Minute (0-59): ", minute2
If minute2 < 0 Or minute2 > 59 Or minute2 <> Int(minute2) Then GoTo minute:
second:
Input "Second (0-59): ", second2
If second2 < 0 Or second2 > 59 Or second2 <> Int(second2) Then GoTo second:
alarm = 1
Cls
_Title "Time and Date - Alarm Set"
GoTo start:
![[Image: screenshot-fullscreen.jpg]](https://i.ibb.co/0yWTPBXB/screenshot-fullscreen.jpg)
![[Image: sccreenshot-Speed-Bible-window.jpg]](https://i.ibb.co/TqdwCG5h/sccreenshot-Speed-Bible-window.jpg)
![[Image: Ken-s-LCD-Clock.jpg]](https://i.ibb.co/Cp0gj1L0/Ken-s-LCD-Clock.jpg)
