| 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
|
|
|
| Dated Material |
|
Posted by: bplus - 12-23-2022, 03:03 PM - Forum: Christmas Code
- Replies (2)
|
 |
Code: (Select All) Print Date$
elf Date$
Sub elf (expression$)
If Val(Mid$(expression$, 3, 2)) < 26 Then SleighRide
End Sub
Sub SleighRide
Print "Paste your clipboard to your browser."
_Clipboard$ = "https://www.google.com/search?client=opera&q=sleigh+ride+song&sourceid=opera&ie=UTF-8&oe=UTF-8#fpstate=ive&vld=cid:95aee982.7113414d,vid:3oWbvWQcuPk,st:0"
Sleep 15
Cls
Print "Merry Christmas!"
End Sub
|
|
|
| An even better Pete.BAS! |
|
Posted by: SMcNeill - 12-22-2022, 07:18 PM - Forum: Christmas Code
- Replies (10)
|
 |
Pete posted his glorious Pete.BAS example over here: https://staging.qb64phoenix.com/showthre...1#pid11971
So... I had to one up it! Here's the new and improved "Steve(tm) Improved Pete.BAS"
Code: (Select All) Screen Pete
_Title "Steve(tm) Improved Pete.BAS"
Randomize Timer
If Play(0) = 0 Then
Play "MBMNT210O3L4EEEP4EEEP4EGCDL1EL4FFFFFEEL8EEL4EDDEL2DL4G"
Play "P4O3L4EEEP4EEEP4EGCDL1EL4FFFFFEEL8EEL4GGFDL4CL1"
Play "MBMNT200O3L4CFL8FGFEL4DDDGL8GAGF"
Play "L4ECCAL8AB-AGL4FDL8CCL4DGEL2F"
Play "L4CFFFL2EL4EFEDL2CL4CAGF"
Play "O4L4CO3L4CL8CCL4DGEL2F"
Play "L4CFL8FGFEL4DDDGL8GAGFL4ECCAL8AB-AG"
Play "L4FDL8CCL4DGEL2F "
End If
Do
PlotChar "Xmas Pete"
_Limit 15
_Display
Loop Until _KeyHit
System
Sub PlotChar (text$)
Static tempScreen
If tempScreen = 0 Then tempScreen = _NewImage(8000, 100, 32)
d = _Dest: s = _Source
_Dest tempScreen
Cls , 0
Color , 0
Print text$;
_Source tempScreen
_Dest d
For i = 0 To Len(text$) - 1
a$ = Mid$(text$, i + 1, 1)
For y = 0 To 16
For x = 0 To 8
Color Int(Rnd * 16) + 16, Int(Rnd * 8)
Locate y + 5, i * 8 + x + 4
If Point(x + i * 8, y) Then Print a$;
Next
Next
Next
_Source s
End Sub
|
|
|
|
| X-Racer |
|
Posted by: James D Jarvis - 12-22-2022, 06:28 PM - Forum: Programs
- Replies (7)
|
 |
It's rude, it's crude, it's a classic that works most of the time.
X-Racer is a text mode racing game where you are in a timed trial to get to the finish line.
Avoid the barriers and the sides or you are going to crash. The game is key driven but doesn't wait for you to press the enter key for long.
space bar - to accelerate
< - turn (screen) left
> - turn (screen) right
b - to brake
(there's still a few problems with the code but if you don't explode at the start of the race you might be able to race to the end)
Code: (Select All) 'X-racer is an old school racing game using text graphics only
'press spacebar to get that engine going and < or > to steer b to brake!
_Title "X-RACER"
track$ = "####OOO................OOO####"
n = 13
trend = 0
obstacle = 10
Randomize Timer
Dim b$(2010)
Dim nn(2010)
start:
ask$ = "."
spd = 1
Do
Cls
For x = 1 To 2010
A$ = String$(n, 32)
b$(x) = A$ + track$
If x > 100 And x Mod obstacle Then
If Rnd * 100 < obstacle Then Mid$(b$(x), n + Int(3 + Rnd * 18), 1) = "O"
End If
n = n + Int(Rnd * 2) - Int(Rnd * 2) + trend
If n < 2 Then n = 2
If n > 35 Then n = 35
nn(x) = n
If Rnd * 100 < 3 Then
Select Case Int(Rnd * 3)
Case 0
trend = 0
Case 1
trend = -1
Case 2
trend = 1
End Select
End If
Next x
b$(1995) = A$ + "####O============O####"
b$(1991) = A$ + "####O============O####"
b$(1992) = A$ + "####O O####"
b$(1993) = A$ + "####O FINISH O####"
b$(1994) = A$ + "####O O####"
b$(1995) = A$ + "####O============O####"
For x = 1996 To 2010
b$(x) = A$ + "####O O####"
Next x
dp = nn(1) + 11
op = dp
For x = 1 To 2010
_Limit 20
If x > 10 Then Color 12: _PrintString (dp, 10), "X": Color 15
_PrintString (op, 9), "."
Print b$(x);
If x > 12 Then
If Mid$(b$(x - 13), dp, 1) = "O" Then GoTo crash
End If
op = dp
If x Mod 20 = 0 Then
Print " - "; x * 5
Else
Print
End If
If x > 10 Then
gg = 0
Do
_Limit 60
gg = gg + 1
kk$ = InKey$
Loop Until kk$ <> "" Or gg = 30 - spd
End If
If x = 12 Then t1 = Timer
Select Case kk$
Case ".", ">"
op = dp
dp = dp + 1
Case ",", "<"
op = dp
dp = dp - 1.
Case " "
spd = spd + 1
If spd > 28 Then spd = 28
Case "b"
spd = spd - 2
If spd < 1 Then spd = 1
End Select
mph$ = "MPH : " + Str$(spd * 10)
_PrintString (1, 2), mph$
Next x
t2 = Timer
Print
Print "Finished Course !"
Print
Print "Finish Time "; t2 - t1
Input "Play again (Y or N) ", ask$
ask$ = UCase$(ask$)
If ask$ = "N" Then GoTo alldone
Loop
End
crash:
For c = 1 To 6
_Limit 8
Color 12
For cx = dp - c To dp + c
For cy = 10 - c To c + 10
If Rnd * 6 < 3 Then _PrintString (cx, cy), "@"
Next cy
Next cx
Next c
Color 15
Print "YOU CRASHED"
Input "Play again (Y or N) ", ask$
ask$ = UCase$(ask$)
If ask$ = "N" Then GoTo alldone
GoTo start
alldone:
End
|
|
|
|
| My latest acheivement: PETE.BAS |
|
Posted by: Pete - 12-22-2022, 03:57 PM - Forum: General Discussion
- Replies (14)
|
 |
Ha, ha, made you look!
I'm off to a roaring start. Sure, I only have one keyword so far, CLS, but it works, flawlessly! Be sure to look it up in my Keyword for the Year blog.
One other consideration. PETE.BAS only runs on laptops and mobile devices. That's right, it's never PC!
Pete
Sorry, hitting the eggnog a bit early this year.
|
|
|
|
| Sound Command |
|
Posted by: johnno56 - 12-22-2022, 08:14 AM - Forum: General Discussion
- Replies (13)
|
 |
I am some-what familiar with the sound command and its parameters. My question is: How does QB64pe generate the tones? Does it have some kind of library of tones or some other method in generating the tones or perhaps accesses the hardware (sound card) directly? Just curious...
Have a great Xmax and an even better New Year!!!
J
|
|
|
|
| DAY 042: _BLINK |
|
Posted by: Pete - 12-22-2022, 01:32 AM - Forum: Keyword of the Day!
- No Replies
|
|
Brought to you by The Keyword of the Day Update Team!
And now, our Keyword of the Day Update reporter, Roseanne Roseannadanna.
Good evening coders. Did you ever ask yourself, "Hey, wait one darn minute. What do I need with a bunch of stupid blinking text letters, when what I really need is nice little cutesie tootsie high intensity background to put my regular non-stupid non-flashing text letters on." Well now I, your Keyword of the Day Update reporter, Roseanne Roseannadanna, have just the news you want to hear!
SYNTAX: _BLINK {ON|OFF}
Usage: Disable or re-enable SCREEN 0 text blinking and provide high intensity background colors when disabled.
Demo
Code: (Select All) COLOR 16, 7: CLS
LOCATE 2, 2: PRINT "This is black blinking text over a light grey bckground. Press a key..."
SLEEP
_BLINK OFF ' This changes our background colors to high intensity colors.
LOCATE 4, 2: PRINT "Now the same text is printed in black over bright white, "
PRINT " because blinking was disabled. Press a key..."
SLEEP
COLOR 0, 7
LOCATE 7, 2: PRINT "This is the lower color register for black."
LOCATE 8, 2: PRINT "See how the background is no longer high-intensity? Press a key..."
SLEEP
COLOR 16, 7
LOCATE 10, 2: PRINT "Now let's see the high-intensity backgrounds we get with blinking disabled."
PRINT " Press a key each time to see a new background color..."
j = 0
DO
COLOR 16, j
LOCATE 13, 2: PRINT "Color 16,"; j;
j = j + 1
SLEEP
LOCATE 13, 2: PRINT SPACE$(12);
IF j = 15 THEN j = 0
LOOP
Now Jane, you may be asking yourself, "Hey Roseanne, how do I check to see if I have blinking on or off? Well I tell you Jane, you just use the _BLINK function...
Code: (Select All) IF _BLINK THEN
PRINT "I'm blinking"
ELSE
PRINT "I'm not blinking"
END IF
So there you have it. Now you can go to bed, get up tomorrow, and tell all your little friends your Keyword of the Day Update Reporter, Roseanne Roseannadanna, has a message for them: _BLINK OFF
And now, back to you, Jane...
Goodnight, and have a pleasant tomorrow.
|
|
|
|
| Merry Xmas! Santa Steve comes bringing gifts to all!! |
|
Posted by: SMcNeill - 12-22-2022, 12:52 AM - Forum: Learning Resources and Archives
- Replies (14)
|
|
https://1drv.ms/u/s!AknUrv8RXVYMm_UjHLPp...q8Lyc?dl=1
As usual, it's Christmas time once again, and those of you who have been members of the QB64 community for a while, you know what that means!! It's the time of year when Santa Steve shows up and offers a hard drive full of goodies for one and all!
Now most years, Santa Steve just downloads and archives the QB64 wiki, and makes them available for one and all so they can have full access to the year's newest wiki information -- but this year, Santa Steve has went above and beyond even that!! This year, Santa Steve is hosting and offering the whole QB64-PE FORUMS as well as the QB64-PE WIKI for everyone to enjoy!!
https://1drv.ms/u/s!AknUrv8RXVYMm_UjHLPp...q8Lyc?dl=1
Grab it at the link above!!
Grab it at this link: https://1drv.ms/u/s!AknUrv8RXVYMm_UjHLPp...q8Lyc?dl=1
Grab it at the link below:
https://1drv.ms/u/s!AknUrv8RXVYMm_UjHLPp...q8Lyc?dl=1
If you want it, there's no reason why you can't grab a copy of the QB64-PE Archives for 2022! It's free! It's available for one and all!
If you're in a country or area that absolutely can't download the 1.3GB archive, then post here! It's Christmas time, for goodness sake! Somebody can burn off a copy of the archive to a DVD and snail mail it to you, if that's absolutely necessary!
QB64-PE Archives 2022 -- for one and for all!!
Enjoy, guys! (And you gals out there too!)
|
|
|
|
Asteroid Shower |
|
Posted by: mnrvovrfc - 12-22-2022, 12:08 AM - Forum: Programs
- Replies (13)
|
 |
The idea of this rather simple game comes from "Astrostorm", which I beheld first on an Apple IIe nearly 40 years back!
Lazy game program. Just press spacebar to start or stop your spaceship. Beware: the response could be a bit late. Work your way toward the top of the screen. The game ends if your spaceship is bashed by an asteroid.
Code: (Select All) 'by mnrvovrfc 2022-dec-21
OPTION _EXPLICIT
DIM AS INTEGER px, py, ph, cm, cb, uc, j, ay, ax, fc
DIM AS LONG kk
DIM AS _BYTE dead, done, holdspace
DIM AS STRING sp40
_TITLE "Astroshower LC"
WIDTH 40, 25: CLS
px = 1: py = 20: ph = 0: cm = 10: cb = 0: kk = 0
sp40 = SPACE$(40)
dead = 0
done = 0
holdspace = 0
uc = 20
fc = 8
LOCATE 24, 1: COLOR 7: PRINT 0;
LOCATE py, px: COLOR fc: PRINT ">";
DO UNTIL dead OR done
IF uc > 0 THEN
uc = uc - 1
IF uc < 1 THEN fc = 15
END IF
FOR j = 1 TO 5
_DELAY 0.015
IF uc < 1 THEN
IF _KEYDOWN(27) THEN done = 1: EXIT FOR
IF _KEYDOWN(32) AND holdspace = 0 THEN
IF cm > 0 THEN cm = cm - 1
holdspace = 1
IF ph = 0 THEN ph = 1 ELSE ph = 0
END IF
IF _KEYDOWN(32) = 0 AND holdspace THEN holdspace = 0
END IF
NEXT ''j
IF done THEN EXIT DO
_DISPLAY
IF ph = 1 THEN
kk = kk + cm + 1
LOCATE 24, 1: COLOR 7: PRINT kk;
COLOR 15
LOCATE py, px: PRINT " ";
px = px + ph
IF px > 40 THEN
px = 1
ph = 0
IF py > 10 THEN
py = py - 1
cb = cb + 1
END IF
cm = cm + cb
END IF
IF SCREEN(py, px) = 42 THEN dead = 1: EXIT DO
LOCATE py, px: PRINT ">";
END IF
j = random1(7) - 4
IF j > 0 THEN
COLOR 7
DO WHILE j > 0
DO
ax = random1(38) + 1
LOOP UNTIL SCREEN(1, ax) = 32
LOCATE 1, ax: PRINT "*";
j = j - 1
LOOP
END IF
LOCATE py, px: COLOR fc: PRINT " ";
COLOR 7
ay = 23
DO WHILE ay > 1
ax = 40
DO WHILE ax > 1
LOCATE ay, ax: PRINT CHR$(SCREEN(ay - 1, ax));
ax = ax - 1
LOOP
ay = ay - 1
LOOP
LOCATE 1, 1: PRINT sp40;
IF SCREEN(py, px) = 42 THEN dead = 1: EXIT DO
LOCATE py, px: COLOR fc: PRINT ">";
LOOP
_AUTODISPLAY
IF dead THEN
LOCATE 1, 1: COLOR 4
PRINT "You have died!";
END
END IF
SYSTEM
FUNCTION random1& (maxval)
random1 = INT(RND * maxval + 1)
END FUNCTION
|
|
|
|
| Library help |
|
Posted by: Pete - 12-21-2022, 08:22 PM - Forum: Help Me!
- Replies (15)
|
|
Anyone know where I can find a cute librarian? Oops, wrong forum...
I'm finding I'd like to have several shorter libraries, rather than combined functions made into a single libraries. For example, I can have a single gui library that creates a form, allows user selection and input, and produces menus, or...
I can have...
Keyboard / Mouse library
Menu library
Form library
Input Text library
What's cool is each of the above could be ported to other apps.
So here's my options...
1) Each library loads the DIM SHARD statements into the main.
2) I have to pass all variables from every library I create, regardless if libraries I include in my app only use some of those variables and arrays.
Frankly I'm leaning towards option 1. To get around naming issues, I'd go with naming the variables in relation to the library they are best associated with like MyMenuChoices$, etc.
What do you guys think or do?
Pete
|
|
|
|
| suggestion: initialize array values within the DIM statement |
|
Posted by: bobalooie - 12-21-2022, 03:36 AM - Forum: General Discussion
- Replies (19)
|
 |
How difficult would it be to implement something similar to this in QB64PE?
OPTION _EXPLICIT
DIM AS LONG LNUMS(5) = {1, 2, 5, 8, 4000}
This is syntax similar to C, and it is also supported to an extent by FreeBASIC. I have used this construct in FreeBASIC, and I have found it useful when initializing short arrays of 'fixed' data in a program.
(I always use OPTION _EXPLICIT, it has saved me more than a few times from fat-fingered typing.)
|
|
|
|
|
