Welcome, Guest |
You have to register before you can post on our site.
|
Latest Threads |
The QB64 IDE shell
Forum: Utilities
Last Post: JasonPag
09-16-2024, 05:37 PM
» Replies: 9
» Views: 762
|
Importance regarding Ches...
Forum: Utilities
Last Post: JasonPag
09-01-2024, 06:34 PM
» Replies: 0
» Views: 31
|
Chess and Analysis and En...
Forum: Utilities
Last Post: JasonPag
08-28-2024, 02:37 PM
» Replies: 0
» Views: 32
|
DAY 009:_PutImage
Forum: Keyword of the Day!
Last Post: grymmjack
09-02-2023, 02:57 PM
» Replies: 54
» Views: 2,034
|
Fall Banner Contest?
Forum: Site Suggestions
Last Post: grymmjack
08-31-2023, 11:50 PM
» Replies: 36
» Views: 1,261
|
ColorPicker - Function th...
Forum: Dav
Last Post: Dav
08-31-2023, 11:04 PM
» Replies: 3
» Views: 315
|
Goals(1) = New Tile()
Forum: Works in Progress
Last Post: RhoSigma
08-31-2023, 09:45 PM
» Replies: 3
» Views: 127
|
micro(A)v11
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 09:14 PM
» Replies: 90
» Views: 3,589
|
Updating The Single Most ...
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 09:13 PM
» Replies: 7
» Views: 254
|
QBJS Image Question
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 05:49 PM
» Replies: 5
» Views: 155
|
|
|
How fast is your OSes keyboard input? |
Posted by: SMcNeill - 08-09-2022, 05:24 AM - Forum: General Discussion
- Replies (9)
|
|
Inspired by Phil's topic about _KEYHIT (Trying to understand keyhit function (qb64phoenix.com), I couldn't help but become curious myself about how often do we need to poll _KEYHIT? Phil's original routine had a limitless loop polling for key events, which is something that I personally *never* think is a good idea. Unthrottled loops are for processing things inside a program -- not for waiting for the user to complete some interaction! What happens if the user suddenly has someone show up at their door at the moment it enters one of these input-feedback loops? They're not there to actually press a key, so what you're dealing with is basically nothing much more than a DO: LOOP which is going to use 100% CPU power, run your PC hot, kick the fans in, use more electricity, and do *NOTHING* beneficial for you!!
Obviously, there should be some sort of limit in how often we check the keyboard for an input event, so my mind instantly begins to ask, "How many times is enough to keep up with reading the buffer, as much as the OS writes to it?" How often does your keyboard record a keypress, and how often does it report it to you? Does it report those events every 1/10 second? every 1/100th? 1/1000??
Honestly, I don't know!!
So, I wrote this little bit of code below to try and see how often my OS would report key events for me:
Code: (Select All) Do
Do
k = _KeyHit
Loop Until k > 0 'some key is pressed down to start the timer
t## = Timer
count = 0 'reset count between loops
Do
k = _KeyHit
If k > 0 Then count = count + 1 'increase the count rate based on the keyboard repeat/limit cycle
Loop Until Timer > t## + 1
Print count; "in 1 second"
_KeyClear
Loop Until k = 27
We start a loop, wait for a key to be pressed down to start a simple timer. Then we count how many keydown events are reported in that second. Finally, we report that number and clear the buffer to recount the process once again, until the user finally hits the ESC key to end the program.
For me, my keyboard on my laptop has a repeat rate of almost consistently 30 key hits per second. (I get reports of 30 and then 31 and then 30 and then 31.... Which seems to be an artifact of rounding and floating point numbers in my opinion.) I think if I set a DO LOOP like these to _LIMIT 30, there'd be almost no noticeable change in how this program works.
Code: (Select All) Do
Do
k = _KeyHit
_Limit 30
Loop Until k > 0 'some key is pressed down to start the timer
t## = Timer
count = 0 'reset count between loops
Do
k = _KeyHit
If k > 0 Then count = count + 1 'increase the count rate based on the keyboard repeat/limit cycle
_Limit 30
Loop Until Timer > t## + 1
Print count; "in 1 second"
_KeyClear
Loop Until k = 27
Try the first program and see what type of results you get. Try the second, with a _Limit 30 placed inside each loop and see if the performance changes much (if any at all) for you. For me, there's absolutely no difference in performance, leading me to think that if I'm running a program with an endless _KEYHIT loop like these, then there's absolutely no reason for me to run them with anything faster than a _LIMIT 30 in them. On my laptop at least, I don't seem to get keyhit events any faster than 30 times per second, so it really doesn't seem like I'd need to use CPU resources and run my program usage up beyond that point.
What I'm curious about now is other people's computers/OS. How often does your system update and report a keyhit event? Is there anyone who runs much higher with a repeat rate faster than 30 times per second? _Limit 30 works fine for me, but would it be throttling down someone else's system too much??
Honestly, if I was going to code this for a working program, I'd probably just make it a _LIMIT 60, and say "Good enough!!" with it. Twice what mine reports, so I figure that'll handle the majority of PCs out there and still not use an excessive amount of resources. Anyone higher than that, can just sort the code out and tweak it themselves. ;D
|
|
|
Trying to understand keyhit function |
Posted by: PhilOfPerth - 08-09-2022, 02:52 AM - Forum: Help Me!
- Replies (3)
|
|
Trying to get my tiny brain around the _keyhit command... It seems to switch to the negative key value when the key is released, but with this simple piece, it seems to have retained its positive value. Where am I going wrong?
Code: (Select All) Color 0, 15: Cls
Message:
k = 0 ' I need this because _keyhit retains its positive (key pressed) value
Print "Press A or B"
Do Until k > 0 ' do this until _keyhit is positive
k = _KeyHit ' set k to _keyhit value
Loop
' now leave loop with k set at positive value from _keyhit
Select Case k
Case Is = 65, 97 ' "A" pressed
ResponseA
Case Is = 66, 98 ' "B" pressed
ResponseB
Case Else
WrongKey
End Select
Cls
GoTo Message
Sub ResponseA
Print "A pressed"
Sleep 1
End Sub
Sub ResponseB
Print "B pressed"
Sleep 1
End Sub
Sub WrongKey
Print "Wrong Key!"
Sleep 1
End Sub
|
|
|
Game Tutorial Updated |
Posted by: TerryRitchie - 08-08-2022, 08:16 PM - Forum: Learning Resources and Archives
- Replies (22)
|
|
I updated the game tutorial to now reflect links that point to qb64phoenix.com
All links on the home page have been updated. All images, links, and directions have been updated in Task 1 to reflect using the Phoenix site and resources to install QB64 and the tutorial asset files.
I need to go through all the other tasks and update the Wiki links to point to the phoenix Wiki as well.
I'm currently looking into using something like WordPress to bring this tutorial into the modern era. I currently use Notepad and Kompozer which is a big pain in the ASCII to use when it comes to updating things. I've never been great at HTML and a WYSIWYG solution would be ideal. I've looked at WordPress and Wix. Any thoughts?
Perhaps the tutorial could somehow be incorporated into the Phoenix Wiki?
|
|
|
Gamma Eats |
Posted by: James D Jarvis - 08-08-2022, 04:53 PM - Forum: Programs
- No Replies
|
|
Along with being a hobbyist programmer I've been a tabletop RPG fan for over 40 years now. this program was written as a simple utility for my own home RPG campaign. The output will be amusing and baffling if you have no idea what this is all for. WhatI really want to share here is how I generate the lists using data reads and tags inside the data to build the lists.
The buildlist sub does most of the work. I keep fiddling with the data for lists like this so working up this sub to work as it does was the simplest approach for me. I could get fancy and make it work when reading from a data file but I haven't had the need to do that yet. I had an older method that restored to specific blocks of data but tracking the locations is very cumbersome in a more dymanic program model (can't keep labels in strings all by themselves).
I use a simple trick to randomly select an entry from each list (which are each string arrays). I record the upper bound when the list is read and shove it into element 0 for recalling later. I could probably just do the Ubound call but I have another utility that uses similar lists where I use a more complicated dice roller algorithm that stores the dice range in that position so I'm keeping the general method consistent across programs.
The output goes to a console window so I can copy and paste the output into another document with ease and don't have to worry about tracking data files and then just copying and pasting into my game documents later.
I could have created a boringly generic example to share, but that's just not much fun.
Code: (Select All) 'gamma eats
'generate specific dishes available in Gamma World shelters, hovels, and roadside diners
'Some of data here comes from the 1st edition of the GammaWorld RPG orignally published by TSR games and is used without explict permission as fan support materials
$ScreenHide
'$dynamic
Randomize Timer
$Console
_Console On
_Dest _Console
_ScreenHide
Dim Shared critter$(999), bug$(999), egg$(999), larva$(999), milk$(999)
Dim Shared vegimal$(999), vegipart$(999), broth$(999), meatprep$(999), meatpart$(999)
Dim Shared eggprep$(999), cereal$(999), Baked$(999), pasta$(999), dairy$(999), vegprep$(999)
Dim Shared mixedmeal$(999), sauce$(999), oldfoodflavor$(999), oldfoodform$(999), oldcontainer$(999)
buildlist "/start:critter", critter$()
buildlist "/start:bug", bug$()
buildlist "/start:egg", egg$()
buildlist "/start:larva", larva$()
buildlist "/start:milk", milk$()
buildlist "/start:vegimal", vegimal$()
buildlist "/start:vegipart", vegipart$()
buildlist "/start:broth", broth$()
buildlist "/start:meatprep", meatprep$()
buildlist "/start:meatpart", meatpart$()
buildlist "/start:eggprep", eggprep$()
buildlist "/start:cereal", cereal$()
buildlist "/start:baked", Baked$()
buildlist "/start:pasta", pasta$()
buildlist "/start:dairy", dairy$()
buildlist "/start:mixedmeal", mixedmeal$()
buildlist "/start:vegprep", vegprep$()
buildlist "/start:sauce", sauce$()
buildlist "/start:oldfoodflavor", oldfoodflavor$()
buildlist "/start:oldfoodform", oldfoodform$()
buildlist "/start:oldcontainer", oldcontainer$()
For reps = 1 To 20
pick = Int(1 + Rnd * 16)
Select Case pick
Case 1, 2
DD$ = "Salad of "
a$ = vegimal$(1 + Int(Rnd * 8)) + " " + vegipart$(1 + Int(Rnd * 8))
If Rnd * 6 < 4.2 Then a$ = vegprep$(1 + Int(Rnd * 5)) + " " + a$
b$ = vegimal$(1 + Int(Rnd * 8)) + " " + vegipart$(1 + Int(Rnd * 8))
If a$ = b$ Then b$ = meatprep$(1 + Int(Rnd * 3)) + " " + vegimal$(1 + Int(Rnd * 8)) + " " + vegipart$(1 + Int(Rnd * 8))
DD$ = DD$ + a$ + " and " + b$
Case 3
DD$ = vegimal$(1 + Int(Rnd * 8)) + " " + cereal$(1 + Int(Rnd * 4))
Case 4
a$ = eggprep$(1 + Int(Rnd * 9))
b$ = " " + egg$(1 + Int(Rnd * 10)) + " eggs"
C$ = " "
If a$ = "Omelette" Then
a$ = "Omelette of"
C$ = " with " + vegimal$(1 + Int(Rnd * 8)) + " " + vegipart$(1 + Int(Rnd * 8))
End If
If Rnd * 6 < 4 Then
DD$ = a$ + b$ + C$
Else
DD$ = a$ + b$ + C$ + " and " + Baked$(1 + Int(Rnd * 6))
End If
Case 4, 5, 6
a$ = meatprep$(1 + Int(Rnd * Val(meatprep$(0))))
b$ = critter$(1 + Int(Rnd * Val(critter$(0))))
DD$ = a$ + " " + b$
Select Case Int(1 + Rnd * 10)
Case 1
DD$ = DD$ + " smothered in " + sauce$(1 + Int(Rnd * Val(sauce$(0)))) + " sauce"
Case 2
DD$ = DD$ + " drizzled with " + sauce$(1 + Int(Rnd * Val(sauce$(0)))) + " sauce"
Case 3
DD$ = DD$ + " served in a puddle of " + sauce$(1 + Int(Rnd * Val(sauce$(0)))) + " sauce"
Case 4
DD$ = DD$ + " in red-eyed gravy"
Case 5
DD$ = DD$ + " with a generous portion of seasoned pan-drippings"
Case 6
DD$ = DD$ + " with a thin sauce of drippings"
Case 7, 8
DD$ = DD$ + " with some " + sauce$(1 + Int(Rnd * Val(sauce$(0)))) + " sauce on the side"
Case 9, 10
End Select
Case 7, 8
a$ = pasta$(1 + Int(Rnd * Val(pasta$(0))))
b$ = sauce$(1 + Int(Rnd * Val(sauce$(0))))
C$ = milk$(1 + Int(Rnd * Val(milk$(0)))) + " cheese"
Select Case Int(1 + Rnd * 12)
Case 1, 2
DD$ = a$ + " served with a " + b$ + " sauce"
Case 3, 4
DD$ = a$ + " mixed with a " + b$ + " sauce"
Case 5, 6
DD$ = a$ + " and " + C$
Case 7, 8, 9
DD$ = a$ + " served in a thin broth"
Case 10
DD$ = a$ + " served with a " + b$ + " sauce and " + C$
Case 11
DD$ = "Plain " + a$
Case 12
DD$ = "Plain" + a$ + " and a bottle of ketchup"
End Select
Case 9
Select Case Int(1 + Rnd * 9)
Case 1, 2, 3, 4
a$ = critter$(1 + Int(Rnd * Val(critter$(0))))
Case 5, 6
a$ = bug$(1 + Int(Rnd * Val(bug$(0))))
Case 7, 8, 9
a$ = vegimal$(1 + Int(Rnd * Val(vegimal$(0))))
End Select
Select Case Int(1 + Rnd * 6)
Case 1, 2, 3
b$ = "burger"
Case 4, 5
b$ = "slider"
Case 6
b$ = "patties"
End Select
Select Case Int(1 + Rnd * 8)
Case 1, 2, 3
C$ = "with a melted slice of " + milk$(1 + Int(Rnd * Val(milk$(0)))) + " cheese"
Case 4
C$ = "smothered in " + milk$(1 + Int(Rnd * Val(milk$(0)))) + " cheese"
Case 5, 6
C$ = " with an ancient slice of processed cheese-food"
Case 7, 8
C$ = "plain"
End Select
Select Case Int(1 + Rnd * 6)
Case 1, 2
d$ = " on a toasted bun"
Case 3
d$ = " on a stale bun"
Case 4
d$ = " on toasted bread"
Case 5, 6
d$ = " on soggy bread"
End Select
If C$ = "plain" Then
DD$ = a$ + " " + b$ + d$
Else
DD$ = a$ + " " + b$ + " " + C$ + d$
End If
Case 10 'full gamma breakfast
a$ = eggprep$(1 + Int(Rnd * Val(eggprep$(0)))) + " " + egg$(1 + Int(Rnd * Val(egg$(0)))) + " eggs "
b$ = meatprep$(1 + Int(Rnd * Val(meatprep$(0)))) + " " + critter$(1 + Int(Rnd * Val(critter$(0))))
If Int(Rnd * 6) < 3.5 Then
b$ = b$ + "," + Str$(2 + Int(Rnd * 3)) + " slices of CRAM"
End If
C$ = vegimal$(1 + Int(Rnd * Val(vegimal$(0)))) + " " + cereal$(1 + Int(Rnd * Val(cereal$(0))))
d$ = vegprep$(1 + Int(Rnd * Val(vegprep$(0)))) + " " + vegimal$(1 + Int(Rnd * Val(vegimal$(0)))) + " " + vegipart$(1 + Int(Rnd * Val(vegipart$(0))))
e$ = Baked$(1 + Int(Rnd * Val(Baked$(0))))
Select Case Int(1 + Rnd * 12)
Case 1, 2
e$ = " a warm " + e$
Case 3
e$ = " rock hard " + e$
Case 4
e$ = " stale " + e$
Case 5, 6
e$ = " toasted " + e$
Case 7
e$ = " crumbling " + e$
Case 8
e$ = " soggy " + e$
Case 9, 10, 11, 12
e$ = e$
End Select
DD$ = a$ + ", " + b$ + ", " + C$ + ", " + d$ + " and " + e$
Case 11, 12, 13
Select Case Int(1 + Rnd * 10)
Case 1, 2, 3
a$ = critter$(1 + Int(Rnd * Val(critter$(0))))
Case 5, 6
a$ = bug$(1 + Int(Rnd * Val(bug$(0))))
Case 7, 8, 9, 10
a$ = vegimal$(1 + Int(Rnd * Val(vegimal$(0))))
End Select
b$ = vegimal$(1 + Int(Rnd * Val(vegimal$(0)))) + " " + vegipart$(1 + Int(Rnd * Val(vegipart$(0))))
C$ = broth$(1 + Int(Rnd * Val(broth$(0))))
Select Case Int(1 + Rnd * 12)
Case 1, 2, 3
t$ = "A warm bowl of "
Case 4, 5, 6
t$ = "A piping hot bowl of "
Case 7
t$ = "A cold bowl of "
Case 8, 9
t$ = "A tepid cup of "
Case 10, 11, 12
t$ = "A warm cup of "
End Select
DD$ = t$ + a$ + " and " + b$ + " " + C$
Case 14, 15, 16
a$ = oldfoodflavor$(1 + Int(Rnd * Val(oldfoodflavor$(0))))
b$ = oldfoodform$(1 + Int(Rnd * Val(oldfoodform$(0))))
C$ = oldcontainer$(1 + Int(Rnd * Val(oldcontainer$(0))))
Select Case Int(1 + Rnd * 6)
Case 1, 2, 3
C$ = "A freshly opened " + C$ + " of"
Case 4, 5
C$ = "Half a " + C$ + " of"
Case 6
C$ = "Some"
End Select
DD$ = C$ + " " + a$ + " " + b$
If Rnd * 6 < 4.5 Then
Select Case Int(1 + Rnd * 8)
Case 1, 2
DD$ = DD$ + ", stale"
Case 3, 4
DD$ = DD$ + ", has a chemical aftertaste"
Case 5
DD$ = DD$ + ", surpirsingly tasty"
Case 6
DD$ = DD$ + ", bland"
Case 7
DD$ = DD$ + ", it smells a bit off"
Case 8
DD$ = DD$ + ", it smells a bit off but tastes fine"
End Select
End If
Case 17, 18
a$ = mixedmeal$(1 + Int(Rnd * Val(mixed$(0))))
Select Case Int(1 + Rnd * 4)
Case 1
b$ = critter$(1 + Int(Rnd * Val(critter$(0))))
Case 2
b$ = bug$(1 + Int(Rnd * Val(bug$(0))))
Case 3, 4
b$ = vegimal$(1 + Int(Rnd * Val(vegimal$(0))))
End Select
C$ = oldfoodflavor$(1 + Int(Rnd * Val(oldfoodflavor$(0)))) + " " + oldfoodform$(1 + Int(Rnd * Val(oldfoodform$(0))))
If Rnd * 8 < 5 Then
C$ = C$ + ", " + oldfoodflavor$(1 + Int(Rnd * Val(oldfoodflavor$(0)))) + " " + oldfoodform$(1 + Int(Rnd * Val(oldfoodform$(0))))
End If
d$ = sauce$(1 + Int(Rnd * Val(sauce$(0))))
DD$ = a$ + " of " + b$ + "," + C$ + " with a " + d$ + " sauce "
If Rnd * 8 < 4 Then
DD$ = DD$ + "and " + milk$(1 + Int(Rnd * Val(milk$(0)))) + dairy$(1 + Int(Rnd * Val(dairy$(0))))
End If
End Select
If reps < 10 Then Print " ";
If reps > 9 And reps < 100 Then Print " ";
Print _Trim$(Str$(reps)); "." + " " + _Trim$(DD$)
Next reps
'eatbale critters
Data "/start:critter","Barl Nep","Blight","Brutorz","Centisteed","Cren Tosh","Ert","Fleshin","Herkel","Hopper"
Data "Keeshin","Podog","Rakox","Sep","Terl","Zarn","Rat","/END"
'edible bugs
Data "/start:bug","Arn","Blaash","Herp","Parn","Soul Besh","Locust","Roach","Ant","/END"
'critter eggs
Data "/start:egg","Arn","Barl Nep","Blassh","Blight","Cal Then","Ert Telden","Fleshin","Herp","Terl","Ant","/END"
'critter larva
Data "/start:larva","Arn","Blash","Blight","Cal Then","Herp","Parn","Soul Besh","Ant","/END"
'critter milk
Data "/start:milk","Brutorz","Hopper","Centisteed","Rakox","/END"
'vegimals
Data "/start:vegimal","Crep Plant","Horl Choo","Kai Lin","Kep","Narl Ep","Pineto","Seroon Lou","Zeeth","/END"
'vegparts
Data "/start:vegipart","Fronds","Shoots","Seeds","Roots","Starch","Leaves","Pulp","Stalk","Sprouts","/END"
'broths
Data "/start:broth","Broth","Stew","Soup","Chowder","Bisque","Goulash","Gumbo","/END"
'meatprep
Data "/start:meatprep","Dried","Pickled","Roasted","Salted","Jerked","Smoked","Corned","Minced","Shredded","Cured"
Data "Jellied","Deep-Fried","Seared","Fried","Baked","Boiled","/END"
'meatparts
Data "/start:meatpart","Brain","Tongue","Belly","Shank","Liver","Kidney","Foot","Ear","Chitlins","Offal","/END"
'eggprep
Data "/start:eggprep","Boiled","Fried","Scrambled","Poached","Omelette","Shirred","Basted","Pickled","Scotched","/END"
'mixedmeal
Data "/start:mixedmeal","Casserole","Dumplings","Pie","Turnovers","Jambalya","Scramble","Hash","/END"
'cereals
Data "/start:cereal","Porridge","Gruel","Mush","Mash","/END"
'bakedgoods
Data "/start:baked","Bread","Flatbread","Cake","Biscuit","Cracker","Muffin","/END"
'pasta
Data "/start:pasta","Noodles","Raviolli","Spaghetti","Couscous","Lasagna","/END"
'dairy
Data "/start:dairy","Milk","Cheese","Yogurt","Cream","Curds","Butter","Cottage Cheese","/END"
'vegprep
Data "/start:vegprep","Fresh","Dried","Sun-dried","Pickled","Fermented","Blanched","Seared","Roasted","/END"
'sauces
Data "/start:sauce","Garlic","Thin","Zesty","Fruity","Peppery","Spicy","Piquant","Tangy","Bar-B-Q","Bitter","Savory","Creamy","Green","Red","Cheese","/END"
Data "/start:oldfoodflavor","Cheez","Vega","Vegi","Vegamax","Krilla","Bean","Oat","Soy","Fruity","Choco","Berry","Baaf"
Data "Chucken","Tarkey","Fush","Lomb","Loobster","Crob","Clum","Chom","Nilla","Wheati","Graino","Corn"
Data "Tatter","Potato","Beef","Chicken","Turkey","Fish","Lamb","Soylent","Prawn","Mussel","Mackrel","Tuna"
Data "Pork","Pirk","Melom","Nut","Seed","Peanut","Ginger","Bar-B-Q","Nutri","Nutra","Nutria","Sugar"
Data "Sweet","Honey","Hunee","Coffee","Protien","Prolean","Simulean","Maxilean","Leano","Mushroom","Mashroom","Beefalo","/END"
Data "/start:oldfoodform","Paste","Chews","Tubes","Dumplings","Pockets","Loaf","Biscuits","Crackers","Wafers","Flakes"
Data "Powder","Jelly","Sauce","Curry","Soup","Stew","Broth","Chowder","Crisps","Sausage"
Data "Chili","Steak","Leather","Sticks","Jerky","Milk","Syrup","Nectar","Water","Spread","Puffs"
Data "Butter","Borritos","Wraps","Cubes","Mash","Drink","Granola","Cake","Pie","Muffin","/END"
Data "/start:oldcontainer","Can","Packet","Cup","Readi-Bowl","Insta-cup","Lunch-Pack","Box","Bottle","Jar","Pouch","/END"
Sub buildlist (flag$, list$())
Restore
n = 0
flagfound = 0
Do
Read d$
If flagfound = 1 And d$ <> "/END" Then
n = n + 1
list$(n) = d$
End If
' Print d$
If d$ = flag$ Then flagfound = 1
Loop Until d$ = "/END" And flagfound = 1
ReDim _Preserve list$(n)
top$ = Str$(UBound(list$))
list$(0) = _Trim$(top$)
'Input check$
End Sub
|
|
|
Manual Pyramid Peg Game |
Posted by: SierraKen - 08-08-2022, 05:39 AM - Forum: Programs
- Replies (4)
|
|
This is a computer version of a very old wooden peg pyramid game. Everything is manual so please read the directions at the start page. If you have any questions, please ask. I would also like comments. I thought about making it non-manual with it detecting jumps, etc. but it would add a lot of programming time and I thought that it's good enough the way it is, just like the original. I think I saw someone make this, or something like this many months ago on the old forum, but I wanted to make my own version. I also know there's a lot of code here and better programmers could have made it a lot less, but I just kept it simple.
I hope you have fun with it!
Code: (Select All) 'Manual Pyramid Peg Game - by SierraKen"
'Made on August 7, 2022.
'This game only has the pegs and board, you have to use the mouse to control everything.
Screen _NewImage(600, 600, 32)
_Title "Manual Pyramid Peg Game - by SierraKen - Space Bar Resets - Esc Quits"
start:
_Limit 20
Cls
Print " Manual Pyramid Peg Game"
Print: Print
Print " By SierraKen"
Print: Print
Print "This game only has the pegs and board, you have to use the mouse to"
Print "control everything."
Print
Print "How To Play:"
Print "1. First remove one peg anywhere on the board."
Print "2. Then jump over an existing peg, using another existing peg,"
Print " onto an empty hole."
Print "3. First click the peg that you want to jump with to delete it"
Print " from that first hole."
Print "4. Then click the empty hole you are jumping into to add the peg."
Print "5. And then make sure and click the peg you jumped over to delete it."
Print "6. Keep doing this until you cannot jump over any others."
Print "7. To win the game you need to only have one peg left."
Print "8. You can only go in a straight line and cannot skip over other"
Print " holes or pegs."
Print "9. Space Bar resets the game."
Print "10. Esc ends the program."
Print: Print: Print
Print " Click This Screen With Your Mouse To Start."
Do
While _MouseInput: Wend
mouseLeftButton = _MouseButton(1)
If mouseLeftButton Then
Clear_MB 1
GoTo begin:
End If
Loop
begin:
cl = 255
h1 = 0: h2 = 0: h3 = 0: h4 = 0: h5 = 0: h6 = 0: h7 = 0: h8 = 0
h9 = 0: h10 = 0: h11 = 0: h12 = 0: h13 = 0: h14 = 0: h15 = 0
Cls
For yy = 0 To 600
cc = cc + .2
Line (0, yy)-(600, yy), _RGB32(0, 0, cc)
Next yy
cc = 0
Line (300, 50)-(50, 550), _RGB32(200, 84, 0)
Line (300, 50)-(550, 550), _RGB32(200, 84, 0)
Line (50, 550)-(550, 550), _RGB32(200, 84, 0)
Paint (300, 52), _RGB32(200, 84, 0)
'Pegs
'Bottom Holes Left To Right.
cl = 255
For sz = .25 To 15 Step .1
cl = cl - 1
Circle (150, 475), sz, _RGB32(cl, cl, cl)
Next sz
cl = 255
For sz = .25 To 15 Step .1
cl = cl - 1
Circle (225, 475), sz, _RGB32(cl, cl, cl)
Next sz
cl = 255
For sz = .25 To 15 Step .1
cl = cl - 1
Circle (300, 475), sz, _RGB32(cl, cl, cl)
Next sz
cl = 255
For sz = .25 To 15 Step .1
cl = cl - 1
Circle (375, 475), sz, _RGB32(cl, cl, cl)
Next sz
cl = 255
For sz = .25 To 15 Step .1
cl = cl - 1
Circle (450, 475), sz, _RGB32(cl, cl, cl)
Next sz
'Second Level Holes Left To Right
cl = 255
For sz = .25 To 15 Step .1
cl = cl - 1
Circle (185, 400), sz, _RGB32(cl, cl, cl)
Next sz
cl = 255
For sz = .25 To 15 Step .1
cl = cl - 1
Circle (260, 400), sz, _RGB32(cl, cl, cl)
Next sz
cl = 255
For sz = .25 To 15 Step .1
cl = cl - 1
Circle (335, 400), sz, _RGB32(cl, cl, cl)
Next sz
cl = 255
For sz = .25 To 15 Step .1
cl = cl - 1
Circle (410, 400), sz, _RGB32(cl, cl, cl)
Next sz
'Third Level Holes Left To Right
cl = 255
For sz = .25 To 15 Step .1
cl = cl - 1
Circle (225, 325), sz, _RGB32(cl, cl, cl)
Next sz
cl = 244
For sz = .25 To 15 Step .1
cl = cl - 1
Circle (300, 325), sz, _RGB32(cl, cl, cl)
Next sz
cl = 255
For sz = .25 To 15 Step .1
cl = cl - 1
Circle (375, 325), sz, _RGB32(cl, cl, cl)
Next sz
'Fourth Level Holes Left To Right
cl = 255
For sz = .25 To 15 Step .1
cl = cl - 1
Circle (265, 250), sz, _RGB32(cl, cl, cl)
Next sz
cl = 255
For sz = .25 To 15 Step .1
cl = cl - 1
Circle (340, 250), sz, _RGB32(cl, cl, cl)
Next sz
'Top Level Hole
cl = 255
For sz = .25 To 15 Step .1
cl = cl - 1
Circle (300, 175), sz, _RGB32(cl, cl, cl)
Next sz
Do
_Limit 20
a$ = InKey$
If a$ = Chr$(27) Then End
If a$ = " " Then GoTo start:
While _MouseInput: Wend
x = _MouseX
y = _MouseY
mouseLeftButton = _MouseButton(1)
If mouseLeftButton Then
Clear_MB 1
'First Bottom Level
If x > 135 And x < 165 And y > 460 And y < 490 And h1 = 0 Then
For sz = .25 To 15 Step .1
Circle (150, 475), sz, _RGB32(100, 50, 50)
Next sz
h1 = 1
x = -100
y = -100
cl = 255
End If
If x > 135 And x < 165 And y > 460 And y < 490 And h1 = 1 Then
cl = 255
For sz = .25 To 15 Step .1
cl = cl - 1
Circle (150, 475), sz, _RGB32(cl, cl, cl)
Next sz
h1 = 0
x = -100
y = -100
cl = 255
End If
If x > 210 And x < 240 And y > 460 And y < 490 And h2 = 0 Then
For sz = .25 To 15 Step .1
Circle (225, 475), sz, _RGB32(105, 50, 50)
Next sz
h2 = 1
x = -100
y = -100
cl = 255
End If
If x > 210 And x < 240 And y > 460 And y < 490 And h2 = 1 Then
For sz = .25 To 15 Step .1
cl = cl - 1
Circle (225, 475), sz, _RGB32(cl, cl, cl)
Next sz
h2 = 0
x = -100
y = -100
cl = 255
End If
If x > 285 And x < 315 And y > 460 And y < 490 And h3 = 0 Then
For sz = .25 To 15 Step .1
Circle (300, 475), sz, _RGB32(105, 50, 50)
Next sz
h3 = 1
x = -100
y = -100
cl = 255
End If
If x > 285 And x < 315 And y > 460 And y < 490 And h3 = 1 Then
For sz = .25 To 15 Step .1
cl = cl - 1
Circle (300, 475), sz, _RGB32(cl, cl, cl)
Next sz
h3 = 0
x = -100
y = -100
cl = 255
End If
If x > 360 And x < 390 And y > 460 And y < 490 And h4 = 0 Then
For sz = .25 To 15 Step .1
Circle (375, 475), sz, _RGB32(105, 50, 50)
Next sz
h4 = 1
x = -100
y = -100
cl = 255
End If
If x > 260 And x < 390 And y > 460 And y < 490 And h4 = 1 Then
For sz = .25 To 15 Step .1
cl = cl - 1
Circle (375, 475), sz, _RGB32(cl, cl, cl)
Next sz
h4 = 0
x = -100
y = -100
cl = 255
End If
If x > 435 And x < 465 And y > 460 And y < 490 And h5 = 0 Then
For sz = .25 To 15 Step .1
Circle (450, 475), sz, _RGB32(105, 50, 50)
Next sz
h5 = 1
x = -100
y = -100
cl = 255
End If
If x > 435 And x < 465 And y > 460 And y < 490 And h5 = 1 Then
For sz = .25 To 15 Step .1
cl = cl - 1
Circle (450, 475), sz, _RGB32(cl, cl, cl)
Next sz
h5 = 0
x = -100
y = -100
cl = 255
End If
'Second Level
If x > 170 And x < 200 And y > 385 And y < 415 And h6 = 0 Then
For sz = .25 To 15 Step .1
Circle (185, 400), sz, _RGB32(105, 50, 50)
Next sz
h6 = 1
x = -100
y = -100
cl = 255
End If
If x > 170 And x < 200 And y > 385 And y < 415 And h6 = 1 Then
For sz = .25 To 15 Step .1
cl = cl - 1
Circle (185, 400), sz, _RGB32(cl, cl, cl)
Next sz
h6 = 0
x = -100
y = -100
cl = 255
End If
If x > 245 And x < 275 And y > 385 And y < 415 And h7 = 0 Then
For sz = .25 To 15 Step .1
Circle (260, 400), sz, _RGB32(105, 50, 50)
Next sz
h7 = 1
x = -100
y = -100
cl = 255
End If
If x > 245 And x < 275 And y > 385 And y < 415 And h7 = 1 Then
For sz = .25 To 15 Step .1
cl = cl - 1
Circle (260, 400), sz, _RGB32(cl, cl, cl)
Next sz
h7 = 0
x = -100
y = -100
cl = 255
End If
If x > 320 And x < 350 And y > 385 And y < 415 And h8 = 0 Then
For sz = .25 To 15 Step .1
Circle (335, 400), sz, _RGB32(105, 50, 50)
Next sz
h8 = 1
x = -100
y = -100
cl = 255
End If
If x > 320 And x < 350 And y > 385 And y < 415 And h8 = 1 Then
For sz = .25 To 15 Step .1
cl = cl - 1
Circle (335, 400), sz, _RGB32(cl, cl, cl)
Next sz
h8 = 0
x = -100
y = -100
cl = 255
End If
If x > 395 And x < 425 And y > 385 And y < 415 And h9 = 0 Then
For sz = .25 To 15 Step .1
Circle (410, 400), sz, _RGB32(105, 50, 50)
Next sz
h9 = 1
x = -100
y = -100
cl = 255
End If
If x > 395 And x < 425 And y > 385 And y < 415 And h9 = 1 Then
For sz = .25 To 15 Step .1
cl = cl - 1
Circle (410, 400), sz, _RGB32(cl, cl, cl)
Next sz
h9 = 0
x = -100
y = -100
cl = 255
End If
'Third Level
If x > 210 And x < 240 And y > 310 And y < 340 And h10 = 0 Then
For sz = .25 To 15 Step .1
Circle (225, 325), sz, _RGB32(105, 50, 50)
Next sz
h10 = 1
x = -100
y = -100
cl = 255
End If
If x > 210 And x < 240 And y > 310 And y < 340 And h10 = 1 Then
For sz = .25 To 15 Step .1
cl = cl - 1
Circle (225, 325), sz, _RGB32(cl, cl, cl)
Next sz
h10 = 0
x = -100
y = -100
cl = 255
End If
If x > 285 And x < 315 And y > 310 And y < 340 And h11 = 0 Then
For sz = .25 To 15 Step .1
Circle (300, 325), sz, _RGB32(105, 50, 50)
Next sz
h11 = 1
x = -100
y = -100
cl = 255
End If
If x > 285 And x < 315 And y > 310 And y < 340 And h11 = 1 Then
For sz = .25 To 15 Step .1
cl = cl - 1
Circle (300, 325), sz, _RGB32(cl, cl, cl)
Next sz
h11 = 0
x = -100
y = -100
cl = 255
End If
If x > 360 And x < 390 And y > 310 And y < 340 And h12 = 0 Then
For sz = .25 To 15 Step .1
Circle (375, 325), sz, _RGB32(105, 50, 50)
Next sz
h12 = 1
x = -100
y = -100
cl = 255
End If
If x > 360 And x < 390 And y > 310 And y < 340 And h12 = 1 Then
For sz = .25 To 15 Step .1
cl = cl - 1
Circle (375, 325), sz, _RGB32(cl, cl, cl)
Next sz
h12 = 0
x = -100
y = -100
cl = 255
End If
'Fourth Level
If x > 250 And x < 280 And y > 235 And y < 265 And h13 = 0 Then
For sz = .25 To 15 Step .1
Circle (265, 250), sz, _RGB32(105, 50, 50)
Next sz
h13 = 1
x = -100
y = -100
cl = 255
End If
If x > 250 And x < 280 And y > 235 And y < 280 And h13 = 1 Then
For sz = .25 To 15 Step .1
cl = cl - 1
Circle (265, 250), sz, _RGB32(cl, cl, cl)
Next sz
h13 = 0
x = -100
y = -100
cl = 255
End If
If x > 325 And x < 355 And y > 235 And y < 265 And h14 = 0 Then
For sz = .25 To 15 Step .1
Circle (340, 250), sz, _RGB32(105, 50, 50)
Next sz
h14 = 1
x = -100
y = -100
cl = 255
End If
If x > 325 And x < 355 And y > 235 And y < 280 And h14 = 1 Then
For sz = .25 To 15 Step .1
cl = cl - 1
Circle (340, 250), sz, _RGB32(cl, cl, cl)
Next sz
h14 = 0
x = -100
y = -100
cl = 255
End If
'Top Hole
If x > 285 And x < 315 And y > 160 And y < 190 And h15 = 0 Then
For sz = .25 To 15 Step .1
Circle (300, 175), sz, _RGB32(105, 50, 50)
Next sz
h15 = 1
x = -100
y = -100
cl = 255
End If
If x > 285 And x < 315 And y > 160 And y < 190 And h15 = 1 Then
For sz = .25 To 15 Step .1
cl = cl - 1
Circle (300, 175), sz, _RGB32(cl, cl, cl)
Next sz
h15 = 0
x = -100
y = -100
cl = 255
End If
End If
Loop
Sub Clear_MB (var As Integer)
Do Until Not _MouseButton(var)
While _MouseInput: Wend
Loop
End Sub 'Clear_MB
|
|
|
CHAIN command not working |
Posted by: TerryRitchie - 08-08-2022, 04:02 AM - Forum: Help Me!
- Replies (14)
|
|
I had someone contact me about using the CHAIN command and not being able to get it to work for them. They sent me their source code and after a few rewrites I can't get it to work either? QB64 continuously complains that it can't find QB64.bas two parent directories below the current working directory.
This also happens regardless if I'm using two .BAS programs from within the editor or using two compiled .EXE files outside the editor as pointed out by the CHAIN Wiki entry.
Has anyone been able to successfully use the CHAIN command? If so, please post some example code so I can see what I may be doing wrong.
For now I gave the user that contacted me other ways of achieving their goal without using CHAIN. I also explained to this user that CHAIN is really no longer needed as it's a relic from the golden age of BASIC, however I would still issue a possible bug report all the same.
Terry
|
|
|
Windows or Linux |
Posted by: aurel - 08-07-2022, 12:52 PM - Forum: General Discussion
- Replies (39)
|
|
On this forum and some others
i see tensions to move from Windows to Linux.
I am not sure why exactly such a "hate" for Windows when i know
that most of -them or us- ...use it before .
I like Windows and Windows is OS for me , i use Linux
just for testing purpose not on every day basis.
So now i am interested to know how many real Linux users use
QB64 for programming .
Is number of Linux users bigger than number of Windows users here on forum?
thanks!
|
|
|
|