| 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,032
|
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
|
|
|
| Steve's 3D Print |
|
Posted by: SMcNeill - 04-27-2022, 08:51 PM - Forum: SMcNeill
- Replies (1)
|
 |
Inspired by Petr's 3D printing, I sat down and worked up a simple little routine to make pseudo-3d text of my own, and I wrapped it up into a single neat little SUB with 3 zillion parameters...
Code: (Select All) SCREEN _NEWIMAGE(1024, 720, 32)
_SCREENMOVE _MIDDLE
OE20 = _LOADFONT("calibri.ttf", 72)
_FONT OE20
Print3D 100, 100, "Hello World", 10, 10, OE20, &HFFFFFF00, 1, 1, 1, 1
Print3D 100, 200, "Steve is Awesome!", 5, -10, OE20, &HFFFF0000, -1, 1, 1, 1.25
Print3D 100, 300, "So, what do you guys think?", 6, 0, OE20, &HFFFFFFFF, 1, .5, .5, .5
Print3D 100, 400, "No 3D, just *italic* style text.", 1, 20, OE20, &HFF00FF00, 0, 0, 1, 1
SUB Print3D (x AS INTEGER, y AS INTEGER, text$, thick AS INTEGER, tilt AS INTEGER,_
f AS LONG, fg AS _UNSIGNED LONG, xchange as integer, ychange as integer,_
scalex as _float, scaley as _float)
DIM copy AS INTEGER
DIM dx1 AS _FLOAT, dx2 AS _FLOAT, dy1 AS _FLOAT, dy2 AS _FLOAT
d = _DEST: s = _SOURCE: font = _FONT
copy = _NEWIMAGE(_WIDTH, _HEIGHT, 32)
_DEST copy: _SOURCE copy
_FONT f
sx1 = 0: sy1 = 0
sx2 = _PRINTWIDTH(text$, copy): sy2 = _FONTHEIGHT(f)
dx1 = x: dy1 = y
dx2 = x + sx2 * scalex: dy2 = y + sy2 * scaley
FOR i = thick TO 0 STEP -1
CLS , 0
COLOR _RGBA32(_RED32(fg), _GREEN32(fg), _BLUE32(fg), 155 + 100 / i), 0
PRINT text$
_MAPTRIANGLE (sx1, sy1)-(sx2, sy1)-(sx1, sy2), copy TO(dx1 + tilt, dy1)-(dx2 + tilt, dy1)-(dx1, dy2), d
_MAPTRIANGLE (sx1, sy2)-(sx2, sy1)-(sx2, sy2), copy TO(dx1, dy2)-(dx2 + tilt, dy1)-(dx2, dy2), d
dx1 = dx1 + xchange: dx2 = dx2 + xchange: dy1 = dy1 + ychange: dy2 = dy2 + ychange
NEXT
_DEST d: _SOURCE s: _FONT font
_FREEIMAGE copy
END SUB
Various thickness is supported. Different tilts are supported. Text can expand from any direction... We can use it to italicize our text if we want to... It scales text to different widths and heights...
It's not a true 3D text, as in we can't rotate it on the x/y/z axis, but it makes a nice imitation text which we can use to create a nice title screen, or such, for our programs.
Play around with it, see what you guys think of it, and I'll be happily awaiting to see how you guys who are much better than me in math will improve/alter this.
Many thanks go to Petr for providing the inspiration for me to sit down and play around with getting this up and going to the point where it is. I'm really quite happy with how it performs and what it can do for us, and I think this will end up going into my toolbox for regular use from now on. 
And a little demo of some of the various styles of 3d text which we can generate with the routine. Watch and pay attention to which direction the text tilts and turns as the program goes along.
Code: (Select All) SCREEN _NEWIMAGE(1024, 720, 32)
_SCREENMOVE _MIDDLE
OE20 = _LOADFONT("calibri.ttf", 72)
_FONT OE20
FOR x = -2 TO 2 STEP 0.1
CLS , 0
Print3D 100, 200, "Steve is Awesome!", 5, x * 20, OE20, &HFFFF0000, x, x, 1, 1.25
_LIMIT 3
_DISPLAY
NEXT
FOR x = -2 TO 2 STEP 0.1
CLS , 0
Print3D 100, 200, "Steve is Awesome!", 5, x * 20, OE20, &HFFFF0000, -x, -x, 1, 1.25
_LIMIT 3
_DISPLAY
NEXT
FOR x = -2 TO 2 STEP 0.1
CLS , 0
Print3D 100, 200, "Steve is Awesome!", 5, x * 20, OE20, &HFFFF0000, x, -x, 1, 1.25
_LIMIT 3
_DISPLAY
NEXT
FOR x = -2 TO 2 STEP 0.1
CLS , 0
Print3D 100, 200, "Steve is Awesome!", 5, x * 20, OE20, &HFFFF0000, -x, x, 1, 1.25
_LIMIT 3
_DISPLAY
NEXT
SUB Print3D (x AS INTEGER, y AS INTEGER, text$, thick AS INTEGER, tilt AS INTEGER,_
f AS LONG, fg AS _UNSIGNED LONG, xchange as integer, ychange as integer,_
scalex as _float, scaley as _float)
DIM copy AS INTEGER
DIM dx1 AS _FLOAT, dx2 AS _FLOAT, dy1 AS _FLOAT, dy2 AS _FLOAT
d = _DEST: s = _SOURCE: font = _FONT
copy = _NEWIMAGE(_WIDTH, _HEIGHT, 32)
_DEST copy: _SOURCE copy
_FONT f
sx1 = 0: sy1 = 0
sx2 = _PRINTWIDTH(text$, copy): sy2 = _FONTHEIGHT(f)
dx1 = x: dy1 = y
dx2 = x + sx2 * scalex: dy2 = y + sy2 * scaley
FOR i = thick TO 0 STEP -1
CLS , 0
COLOR _RGBA32(_RED32(fg), _GREEN32(fg), _BLUE32(fg), 155 + 100 / i), 0
PRINT text$
_MAPTRIANGLE (sx1, sy1)-(sx2, sy1)-(sx1, sy2), copy TO(dx1 + tilt, dy1)-(dx2 + tilt, dy1)-(dx1, dy2), d
_MAPTRIANGLE (sx1, sy2)-(sx2, sy1)-(sx2, sy2), copy TO(dx1, dy2)-(dx2 + tilt, dy1)-(dx2, dy2), d
dx1 = dx1 + xchange: dx2 = dx2 + xchange: dy1 = dy1 + ychange: dy2 = dy2 + ychange
NEXT
_DEST d: _SOURCE s: _FONT font
_FREEIMAGE copy
END SUB
|
|
|
| Steve's Quick Lesson on Number TYPEs and Colors |
|
Posted by: SMcNeill - 04-27-2022, 08:45 PM - Forum: Learning Resources and Archives
- No Replies
|
|
Salvaged from the other boards, some of you may have seen this before:
Code: (Select All) Screen _NewImage(640, 640, 32)
_Title "Number Types and Colors"
Print "Welcome to Steve's Qucik Lesson on Number Types and Colors."
Print
Print "The most important thing to keep in mind in this lesson is that we're going to be talking exclusively about 32-bit color values here. For all other screen modes, this lesson holds much less importance."
Print
Print "Press <ANY KEY> to begin!"
Sleep
Cls , 0
Print "First, let's talk about how SINGLE variable types work (or DON'T work), in regards to 32-bit colors."
Print
Print "Let's choose a nice color and use it to draw a box on the screen."
Print "How about we choose a BLUE box? _RGB32(0, 0, 255)"
Print
Line (50, 90)-(250, 250), _RGB32(0, 0, 255), BF
Locate 18, 1: Print "Looks like a nice BLUE box. Right?"
Print "Press <ANY KEY> to continue!"
Sleep
Cls , 0
Print "Now, let's store that BLUE value inside a SINGLE tyoe variable."
Print "BLUE = _RGB32(0, 0, 255)"
Print ""
Print "Once we've did that, let's draw the exact same box on the screen again with the variable."
BLUE = _RGB32(0, 0, 256)
Line (50, 90)-(250, 250), BLUE, BF
Locate 18, 1: Print "Looks like a nice BLUE box. Right?"
Print "Press <ANY KEY> to continue!"
Sleep
Cls , 0
Print "What do you guys mean, 'What box?'??"
Print "Do you mean to tell me you nice folks DIDN'T see a pretty BLUE box on the last screen??"
Print
Print
Print "Just what the hell happened to it?!!"
Print
Print
Print "For the answer to that, let's print out two values to the screen:"
Print "BLUE = "; BLUE
Print "_RGB32(0, 0, 255) = "; _RGB32(0, 0, 255)
Print
Print "At first glance, those APPEAR to be the same numbers, but let's expand the scientific notation fully:"
Blue&& = BLUE
Print "BLUE = "; Blue&&
Print "_RGB32(0, 0, 255) = "; _RGB32(0, 0, 255)
Print
Print "Press <ANY KEY> to continue!"
Sleep
Cls , 0
Print "HOLY COW, BATMAN!! Was those two numbers DIFFERENT?!!"
Print "BLUE = "; Blue&&; "vs"; _RGB32(0, 0, 255)
Print
Print "Well... They're only a LITTLE different... Right?"
Print "I mean, how bad can one little number difference be? Right??"
Print
Print "For the answer to that, let's look at the HEX values of those numbers:"
Print "BLUE = "; Hex$(Blue&&)
Print "_RGB32(0, 0, 255) - "; Hex$(_RGB32(0, 0, 255))
Print
Print "And to help understand what we're seeing in HEX, break those values down into groups of 2 in your mind."
Print "(I'm too lazy to do it for you..)"
Print "The first two values are ALPHA, followed by RED, followed by GREEN, followed by BLUE."
Print
Print "So BLUE = FF alpha, 00 red 01 green, 00 blue"
Print "_RGB32(0, 0, 0) = FF alpha, 00 red, 00 green, FF blue"
Print
Print "And keep in mine that FF is HEX for the decimal value of 255."
Print
Print "Press <ANY KEY> to continue!"
Sleep
Cls , 0
Print "Since SINGLE values lose precision after numbers get so large, our variable BLUE"
Print "has to round to the nearest scientific notation point and try for the closest"
Print "possible match."
Print
Print "And even though "; Blue&&; " is only one number off from "; _RGB32(0, 0, 255); ","
Print "that number still greatly changes the color value."
Print
Print "It changes it from FF 00 00 FF (255 alpha, 0 red, 0 green, 255 blue) to"
Print "FF 00 01 00 (255 alpha, 0 red, 1 green, 0 blue)."
Print
Print "Our BLUE has become a GREEN, simply by using a SINGLE variable type!!"
Print "(And, it's such a low shade green, my poor eyes can't make it out at all."
Print "To me, the damn 'green box' was just as black as my black screen."
Print "I didn't see it at all!)"
Print "Press <ANY KEY> to continue!"
Sleep
Cls , 0
Print "So, at this point, I think it should be obvious WHY we don't want to store"
Print "color values inside SINGLE variables."
Print
Print "But what about using a normal LONG to hold the values??"
Print
Print "Let's look and see!"
Print
Print "For this, let's draw our box again:"
Line (50, 150)-(250, 250), _RGB32(0, 0, 255), BF
Locate 18, 1: Print "Looks like a nice BLUE box. Right?"
Print
Print "But let's get the POINT value from that box, and store it in a LONG variable."
BLUE& = Point(100, 200)
Print "BLUE& = "; BLUE&
p&& = Point(100, 200)
Print "POINT(100, 200) = "; Point(100, 200)
Print
Print
Print "Again, we're looking at two numbers that don't match!"
Print
Print "FOR THE LOVE OF GOD, WHYYYY??!!!!"
Print "Press <ANY KEY> to continue!"
Sleep
Cls , 0
Print BLUE&; "<>"; p&&
Print
Print "Why are those two numbers so different??"
Print
Print "For that answer, let's look at their HEX values again:"
Print "BLUE& = "; Hex$(BLUE&)
Print "POINT(100, 200) = "; Hex$(p&&)
Print
Print "."
Print "..."
Print "......"
Print
Print "WHAT THE HEX?? Those two values are EXACTLY the same??"
Print
Print "They are. It's just that one of them is stored as a SIGNED LONG, while the other is an UNSIGNED LONG."
Print
Print "HEX wise, they're the same value..."
Print
Print "BUT, can you see where the two numbers might not match if we use them in an IF statement?"
Print
Print "IF "; BLUE&; "="; p&&; "THEN...."
Print
Print "Ummm... That might not work as intended!"
Print
Print "Press <ANY KEY> to continue!"
Sleep
Cls , 0
Print "Even thought the HEX values for "; BLUE&; "and"; p&&;
Print "are EXACTLY the same, the values themselves are quite different."
Print
Print "A LONG will, indeed, hold the proper value for a 32-bit color, as it stores"
Print "all four HEX values properly for us."
Print
Print "As long as our program uses NOTHING but LONG values, you'll never have a"
Print "problem with using LONG as a variable type..."
Print
Print "BUT...."
Print
Print "The moment you start to compare LONG values directly against POINT values,"
Print "your program is going to run into serious issues!"
Print
Print "Because at the end of the day,"; BLUE&; "is not the same as "; p&&
Print
Print
Print "Press <ANY KEY> to continue!"
Sleep
Cls , 0
Print "So, with all those examples, and all that said, let's answer"
Print "the most important question:"
Print
Print "'What TYPE works best for 32-bit colors??"
Print
Print
Print "DOUBLE, _FLOAT, _UNSIGNED LONG, _INTEGER64, _UNSIGNED _INTEGER64"
Print
Print "Of all the types which QB64 offers, only the above are TRULY viable"
Print "to hold a 32-bit color value."
Print
Print "Any type not listed above is going to be problematic at one time or"
Print "another for us!"
Print
Print "And of those suitable types, I personally prefer to keep integer values"
Print "as integers, so I recommend: _UNSIGNED LONG or _INTEGER64."
Print
Print
Print "Press <ANY KEY> to continue!"
Sleep
Cls , 0
Print "And WHY _UNSIGNED LONG??"
Print
Print "Simply because it's only 4 bytes of memory (the minimal we can possibly use for"
Print "32-bit color values), and it's what QB64 uses internally with POINT and such."
Print
Print
Print "So, if _UNSIGNED LONG works so well, WHY would I *ever* use _INTEGER64??"
Print
Print "Becauses sometimes I like to code command values into my colors."
Print "(Such as: NoColor = -1)"
Print
Print "_UNSIGNED LONG *only* holds the values for the colors themselves."
Print "EVERY number from 0 to FFFFFFFF is accounted for as part of our color spectrum."
Print
Print "If I need *special* or unique values for my program, I usually just use _INTEGER64s"
Print "for my variable types and then I can assign negative numbers for those unique values."
Print
Print
Print "Press <ANY KEY> to continue!"
Sleep
Cls , 0
Print "At the end of the day though, when all is said and done, you're still the"
Print "one responsible for your own code!"
Print
Print "Use whichever type works for you, and works best for your needs."
Print
Print "Just keep in mind: Various TYPEs come with various limitations on your code."
Print
Print "_BYTE, INTEGER, (both signed and unsigned) are insane to use..."
Print "SINLGE loses precision. Expect to lose whole shades of blue...."
Print "LONG may cause issues with POINT, if compared directly...."
Print "_UNSIGNED LONG works fine, any ONLY stores 32-bit color values...."
Print "_INTEGER64 works fine, and can store extra values if necessary...."
Print "DOUBLE and _FLOAT both work, but are floating point values...."
Print
Print
Print "And with all that said and summed up, it's now up to YOU guys to decide what"
Print "works best in your own programs."
Print
Print
Print "As I said, I personally recommend _UNSIGNED LONG or _INTEGER64 in special cases."
Print "But the choice, and the debugging, is entirely up to YOU. :D"
Copy. Paste. Compile. I'll let the code speak for itself and hopefully it'll help folks learn a bit more about WHY certain variables are more suitable for use with 32-bit color values than others.
|
|
|
|
| Beer Wipe - An IDE Screen Saver Utility for a Special Day! |
|
Posted by: Pete - 04-27-2022, 08:00 PM - Forum: TheBOB
- No Replies
|
 |
Beerwipe.bas by Bob Seguin.
![[Image: Screenshot-655.png]](https://i.ibb.co/HTTrWYX/Screenshot-655.png)
Description: A special day screen saver for your QBasic IDE.
Code: (Select All) _TITLE "Beer Wipe by Bob Seguin"
DEFINT A-Z
DIM Box(1 TO 32000)
TYPE BubbleTYPE
x AS INTEGER
y AS INTEGER
END TYPE
DIM Bubbles(1 TO 200) AS BubbleTYPE
FOR n = 1 TO 200
Bubbles(n).x = FIX(RND * 640)
Bubbles(n).y = FIX(RND * 480)
NEXT n
SCREEN 12
_FULLSCREEN
OUT &H3C8, 0
FOR Reps = 1 TO 48
OUT &H3C9, 0
NEXT Reps
PAINT (0, 0), 1
LOCATE 1, 3: PRINT "FileÿÿEditÿÿViewÿÿSearchÿÿRunÿÿDebugÿÿOptions"
LOCATE 1, 75: PRINT "Help"
FOR x = 0 TO 639
FOR y = 0 TO 16
IF POINT(x, y) = 15 THEN PSET (x, y), 0 ELSE PSET (x, y), 7
NEXT y
NEXT x
COLOR 12
LINE (5, 23)-(634, 479), 11, B
LINE (6, 24)-(633, 478), 11, B
LOCATE 2, 38: PRINT "QBASIC"
FOR x = 288 TO 350
FOR y = 16 TO 30
IF POINT(x, y) = 12 THEN PSET (x, y), 1 ELSE PSET (x, y), 11
NEXT y
NEXT x
LINE (5, 421)-(634, 422), 11, B
LOCATE 27, 36: PRINT "Immediate"
FOR x = 270 TO 360
FOR y = 412 TO 431
IF POINT(x, y) = 12 THEN PSET (x, y), 11 ELSE PSET (x, y), 1
NEXT y
NEXT x
LOCATE 30, 3: PRINT "<Shift+F1=Help> <F6=Window> <F2=Subs> <F5=Run> <F8=Step>";
LOCATE 30, 69: PRINT "N 00000:000";
FOR x = 0 TO 639
FOR y = 462 TO 479
IF x < 500 THEN Colr = 15 ELSE Colr = 0
IF POINT(x, y) = 12 THEN PSET (x, y), Colr ELSE PSET (x, y), 3
NEXT y
NEXT x
LINE (500, 462)-(501, 479), 0, B
LINE (606, 16)-(621, 32), 11, BF
LINE (608, 16)-(609, 32), 1, B
LINE (618, 16)-(619, 32), 1, B
LINE (613, 18)-(614, 30), 1, B
LINE (611, 21)-(612, 22), 1, B
LINE (615, 21)-(616, 22), 1, B
LINE (630, 30)-(637, 390), 7, BF
LINE (633, 33)-(634, 46), 0, B
LINE (631, 36)-(632, 37), 0, B
LINE (635, 36)-(636, 37), 0, B
LINE (633, 372)-(634, 386), 0, B
LINE (631, 382)-(632, 383), 0, B
LINE (635, 382)-(636, 383), 0, B
FOR x = 630 TO 638 STEP 4
FOR y = 48 TO 370 STEP 2
PSET (x, y), 0
IF y + 1 <> 415 THEN PSET (x + 2, y + 1), 0
NEXT y
NEXT x
LINE (10, 394)-(629, 414), 7, BF
LINE (11, 404)-(18, 405), 0, B
LINE (13, 402)-(14, 403), 0, B
LINE (13, 406)-(14, 407), 0, B
LINE (621, 404)-(628, 405), 0, B
LINE (624, 402)-(625, 403), 0, B
LINE (624, 406)-(625, 407), 0, B
LINE (20, 394)-(28, 414), 0, BF
FOR x = 28 TO 618 STEP 4
FOR y = 394 TO 414 STEP 2
PSET (x, y), 0
IF y + 1 <> 415 THEN PSET (x + 2, y + 1), 0
NEXT y
NEXT x
LOCATE 4, 4: PRINT "HAPPY SAINT PATRICK'S DAY!"
xx = 68: yy = 200
FOR x = 20 TO 240
FOR y = 44 TO 64
IF POINT(x, y) = 12 THEN
IF y > 54 THEN Colr = 2 ELSE Colr = 10
LINE (x * 2 + xx, y * 2 + yy)-(x * 2 + xx + 1, y * 2 + yy + 1), Colr, B
END IF
PSET (x, y), 1
NEXT y
NEXT x
CIRCLE (300, 130), 32, 3
PAINT STEP(0, 0), 3
CIRCLE (340, 130), 32, 3
PAINT STEP(0, 0), 3
CIRCLE (250, 182), 32, 3
PAINT STEP(0, 0), 3
CIRCLE (258, 216), 32, 3
PAINT STEP(0, 0), 3
CIRCLE (390, 182), 32, 3
PAINT STEP(0, 0), 3
CIRCLE (382, 216), 32, 3
PAINT STEP(0, 0), 3
CIRCLE (288, 169), 8, 3, 3.4, 1.5
CIRCLE (353, 169), 8, 3, 1.8, 5.5
CIRCLE (300, 256), 36, 3, 0, 2.4, 1.8
CIRCLE (340, 258), 40, 3, .8, 3.3, 2
CIRCLE (296, 246), 30, 3, 5, 0, 1.4
CIRCLE (202, 240), 120, 3, 5.95, 0
LINE (302, 275)-(315, 278), 3
LINE (317, 220)-(322, 250), 3, BF
PAINT (320, 199), 3
PAINT (310, 270), 3
YLine = 1
FOR y = 330 TO 78 STEP -1
GET (105, y)-(535, y), Box(YLine)
YLine = YLine + 115
NEXT y
LINE (105, 85)-(535, 330), 1, BF
WAIT &H3DA, 8: WAIT &H3DA, 8, 8
GOSUB SetPALETTE
_DELAY 3
REM StartTIME! = TIMER: DO: LOOP WHILE TIMER < StartTIME! + 2
YYLine = 1
FOR y = 480 TO -40 STEP -1
_DELAY .025
FOR Reps = 1 TO 60
x = FIX(RND * 640)
yy = y + FIX(RND * 16) - 8
Radius = FIX(RND * 12)
CIRCLE (x, yy), Radius, 10
PSET (x + Radius / 2, yy - Radius / 2), 15
NEXT Reps
FOR x = 0 TO 639
IF POINT(x, y) <> 2 AND POINT(x, y) <> 10 THEN PSET (x, y), 1
NEXT x
LINE (0, y + 28)-(639, y + 31), 10, BF
LINE (0, y + 32)-(639, y + 32), 3
IF y = 329 THEN LINE (100, y + 37)-(540, y + 37), 1
IF y = 68 THEN LINE (100, y + 37)-(540, y + 37), 1
IF y >= 78 AND y < 330 THEN
PUT (105, y + 32), Box(YYLine), PSET
YYLine = YYLine + 115
END IF
IF y >= 70 AND y < 332 THEN PSET (100, y + 35), 1: PSET (540, y + 35), 1
FOR n = 1 TO 200
IF POINT(Bubbles(n).x, Bubbles(n).y) = 15 THEN
PSET (Bubbles(n).x, Bubbles(n).y), 3
END IF
Bubbles(n).x = Bubbles(n).x + FIX(RND * 3) - 1
Bubbles(n).y = Bubbles(n).y - 5
IF Bubbles(n).y < 0 THEN
Bubbles(n).y = 479
Bubbles(n).x = FIX(RND * 640)
END IF
IF POINT(Bubbles(n).x, Bubbles(n).y) = 3 THEN
PSET (Bubbles(n).x, Bubbles(n).y), 15
END IF
NEXT n
NEXT y
_KEYCLEAR ' Clear keyboard buffer.
DO
FOR n = 1 TO 200
IF POINT(Bubbles(n).x, Bubbles(n).y) = 15 THEN
PSET (Bubbles(n).x, Bubbles(n).y), 3
END IF
Bubbles(n).x = Bubbles(n).x + FIX(RND * 3) - 1
Bubbles(n).y = Bubbles(n).y - 2
IF Bubbles(n).y < 0 THEN
Bubbles(n).y = 479
Bubbles(n).x = FIX(RND * 640)
END IF
IF POINT(Bubbles(n).x, Bubbles(n).y) = 3 THEN
PSET (Bubbles(n).x, Bubbles(n).y), 15
END IF
NEXT n
LOOP WHILE INKEY$ = ""
_DELAY .5
COLOR 1
SYSTEM
SetPALETTE:
DATA 0,18,0,0,32,0,0,50,0,0,50,0
DATA 42,0,0,42,0,42,42,21,0,32,52,32
DATA 21,21,21,21,21,63,21,63,21,21,63,21
DATA 63,21,21,63,21,63,63,63,21,63,63,63
OUT &H3C8, 0
FOR n = 1 TO 48
READ Intensity
OUT &H3C9, Intensity
NEXT n
RETURN
|
|
|
|
| Checker Board - Checker Board Layout with Two Checkers and Mapping Routine. |
|
Posted by: Pete - 04-27-2022, 07:21 PM - Forum: TheBOB
- No Replies
|
|
Checkerboard.bas by Bob Seguin.
![[Image: Screenshot-582.png]](https://i.ibb.co/fF4MZsc/Screenshot-582.png)
Description: Checker Board with two playing pieces. Read the code in the accompanying Mapping.bas utility below to see how it gets built. The pieces are just graphic characters, they cannot be moved.
Code: (Select All) '----------------------------------------------------------------------------
'
' AN INTRODUCTION TO GAME MAPPING (program example - freeware)
' (See MAPPING.BAS for mapping tutorial)
' Copyright (2000) by Bob Seguin
'
'----------------------------------------------------------------------------
_TITLE "Checkerboard.bas by Bob Seguin"
DEFINT A-Z
DECLARE SUB BOARD ()
DECLARE SUB DrawMAN (x, y, Colr)
DIM SHARED CheckerBOARD(1 TO 8, 1 TO 8)
DATA 1,0,1,0,1,0,1,0
DATA 0,1,0,1,0,1,0,1
DATA 1,0,1,0,1,0,1,0
DATA 0,1,0,1,0,1,0,1
DATA 1,0,1,0,1,0,1,0
DATA 0,1,0,1,0,1,0,1
DATA 1,0,1,0,1,0,1,0
DATA 0,1,0,1,0,1,0,1
FOR Row = 1 TO 8
FOR Col = 1 TO 8
READ CheckerBOARD(Row, Col)
NEXT Col
NEXT Row
SCREEN 12
OUT &H3C8, 0 'Color 0 set to a dark green for background
OUT &H3C9, 0 'so that it can be printed on without creating
OUT &H3C9, 30 'black boxes
OUT &H3C9, 0
OUT &H3C8, 1 'Color 1 set to a black since 0 has been changed
OUT &H3C9, 0
OUT &H3C9, 0
OUT &H3C9, 0
OUT &H3C8, 4 'Color 4 set to a brighter red
OUT &H3C9, 63
OUT &H3C9, 0
OUT &H3C9, 0
BOARD 'Call to sub program to draw checkerboard
RANDOMIZE TIMER 'Assure that each game will be different
'Establish random location for blue game piece making sure it is not on
'the starting square of the white game piece (8, 8). In most cases it won't
'be, so this loop will only iterate once. As long as one of the coordinates
'isn't 8, it's legal, hence the "OR".
DO
BlueMANRow = INT(RND * 8) + 1
BlueMANCol = INT(RND * 8) + 1
LOOP UNTIL BlueMANRow <> 8 OR BlueMANCol <> 8
'Adjust map array accordingly
CheckerBOARD(BlueMANRow, BlueMANCol) = CheckerBOARD(BlueMANRow, BlueMANCol) + 10
'Establish x/y coordinates for blue game piece
BlueMANx = BlueMANCol * 50 + 98 '98 represents left square center - 50
BlueMANy = BlueMANRow * 50 + 15 '15 represents top square center - 50
'Call sub program that draws/erases game pieces
DrawMAN BlueMANx, BlueMANy, 9
'Repeat for white game piece, except starting row/column are fixed: 8, 8
WhiteMANRow = 8
WhiteMANCol = 8
'We know the square is 8/8, therefore red (1) and the white player 20, so...
CheckerBOARD(8, 8) = 21
WhiteMANx = 8 * 50 + 98
WhiteMANy = 8 * 50 + 15
DrawMAN WhiteMANx, WhiteMANy, 15
DO
DO
Key$ = INKEY$
LOOP UNTIL Key$ <> ""
RowINCREMENT = 0: ColINCREMENT = 0
SELECT CASE Key$
CASE CHR$(0) + "H" 'Up
IF WhiteMANRow > 1 THEN RowINCREMENT = -1 ELSE RowINCREMENT = 0
CASE CHR$(0) + "P" 'Down
IF WhiteMANRow < 8 THEN RowINCREMENT = 1 ELSE RowINCREMENT = 0
CASE CHR$(0) + "K" 'Left
IF WhiteMANCol > 1 THEN ColINCREMENT = -1 ELSE ColINCREMENT = 0
CASE CHR$(0) + "M" 'Right
IF WhiteMANCol < 8 THEN ColINCREMENT = 1 ELSE ColINCREMENT = 0
CASE CHR$(27)
SYSTEM
END SELECT
'Test for presence of blue game piece at proposed move location. Since
'the blue game piece is the only object we can possible encounter, I've
'simply used > 1 as a test. Other possiblities would require a more
'complex test.
IF CheckerBOARD(WhiteMANRow + RowINCREMENT, WhiteMANCol + ColINCREMENT) > 1 THEN
RowINCREMENT = 0
ColINCREMENT = 0
END IF
'Here is an added wrinkle. If it is not possible to move in certain
'situations, why bother changing anything, -all you'll succeed in
'doing is cause your game piece to flutter on the spot. Hence, we
'enclose the next section in an IF block. To see the difference it
'makes, REM out the following IF line and the END IF at the bottom,
'then press F5 and hold down any of the arrow keys:
IF RowINCREMENT <> 0 OR ColINCREMENT <> 0 THEN '<---REM out to test
'Decrement map array at old location
CheckerBOARD(WhiteMANRow, WhiteMANCol) = CheckerBOARD(WhiteMANRow, WhiteMANCol) - 20
'Erase white game piece at old location, using the value of the map array
'at those row/col coordinates to establish background color. Since there
'couldn't have been anything on that square but the white game piece,
'it's value after the previous line of code will be either 1:red or
'0:black. (Incidentally, I'm using COLOR 1 for black; see the OUT
'statements at the start of this program for why).
IF CheckerBOARD(WhiteMANRow, WhiteMANCol) = 1 THEN Colr = 4 ELSE Colr = 1
DrawMAN WhiteMANx, WhiteMANy, Colr 'Draws solid circle in background color
'Establish new row/column, x/y coordinates based on increment values
WhiteMANRow = WhiteMANRow + RowINCREMENT
WhiteMANCol = WhiteMANCol + ColINCREMENT
WhiteMANy = WhiteMANy + RowINCREMENT * 50
WhiteMANx = WhiteMANx + ColINCREMENT * 50
'Update map array accordingly
CheckerBOARD(WhiteMANRow, WhiteMANCol) = CheckerBOARD(WhiteMANRow, WhiteMANCol) + 20
'Draw white game piece at new coordinates
DrawMAN WhiteMANx, WhiteMANy, 15
END IF '<----REM out to test
LOOP
END
'NOTE: In this simple little program, I could have taken a few short cuts,
' such as testing for the edge of the board and for the blue game piece
' at the same time, etc.. It is important, however, that you learn to
' think of these things separately, since most games involve much more
' complex circumstances and testing. A chess game, for example, would
' require establishing the computer's next move based on the position
' of every piece on the board (values in the array).
'
' Incidentally, -what values would YOU assign to all 32 chess
' pieces?
'
' Bob Seguin
'
'-----------------------------------------------------------------------------
SUB BOARD
'Sub program draws checkerboard
'----------------------------------------------------------------------------
LINE (10, 10)-(629, 469), 8, B
LINE (7, 7)-(633, 473), 8, B
LINE (118, 35)-(527, 444), 8, BF
LINE (118, 35)-(527, 444), 1, B
FOR x = 123 TO 473 STEP 50
Col = Col + 1
FOR y = 40 TO 390 STEP 50
Row = Row + 1
LINE (x, y)-(x + 50, y + 50), 14, B
IF (Col + Row) MOD 2 THEN Colr = 1: ELSE Colr = 4
PAINT (x + 12, y + 12), Colr, 14
NEXT y
NEXT x
COLOR 8
LOCATE 30, 31: PRINT " PRESS [ESC] TO QUIT ";
'-----------------------------------------------------------------------------
END SUB
SUB DrawMAN (x, y, Colr)
'Sub program draws filled circle at coordinates x/y and in color Colr
'-----------------------------------------------------------------------------
WAIT &H3DA, 8
WAIT &H3DA, 8, 8 'Wait for completed screen retrace to avoid flicker
CIRCLE (x, y), 20, Colr
PAINT (x, y), Colr
'-----------------------------------------------------------------------------
END SUB
Mapping.bas
Code: (Select All) '----------------------------------------------------------------------------
'
' AN INTRODUCTION TO GAME MAPPING (tutorial - freeware)
' Copyright (2000) by Bob Seguin
'
'
'----------------------------------------------------------------------------
DEFINT A-Z
_TITLE "Mapping by Bob Seguin"
'FOR OPENERS...
'Let's start with a simple game example, -a checkerboard type game.
'What we want to do is figure some way to represent this game board in
'a numerical form, such that we can determine at any time and at any
'location, the exact status at that location. In more complex games
'you might wish to know: Did I just run into a wall or enter a building?
'Is a good guy or bad guy at this location? If there is someone here,
'is he carrying a weapon, and if so, what kind of weapon? What is his
'strength and skill level, etc..
'But, for now, let's stick with our simple checkerboard:
'To begin with, we create a two-dimensional array that represents a
'checkerboard: 8 by 8 elements representing the 8 by 8 checkerboard pattern.
'(It is automatically an integer array because of DEFINT A-Z at the top
'of the program, but if you don't use DEFINT A-Z then add AS INTEGER).
DIM SHARED CheckerBOARD(1 TO 8, 1 TO 8)
'Next, we initialize the array using DATA and READ statements, so that
'every red square is equal to 1 and every black square is equal to 0
'in the array representation.
DATA 1,0,1,0,1,0,1,0
DATA 0,1,0,1,0,1,0,1
DATA 1,0,1,0,1,0,1,0
DATA 0,1,0,1,0,1,0,1
DATA 1,0,1,0,1,0,1,0
DATA 0,1,0,1,0,1,0,1
DATA 1,0,1,0,1,0,1,0
DATA 0,1,0,1,0,1,0,1
'You'll notice that even the DATA looks like a checkerboard. Well that is
'the value of a two-dimensional array map, it can be used to represent a
'physical space using logically associated, numerical values.
'Next we READ the DATA into the array...
FOR Row = 1 TO 8
FOR Col = 1 TO 8
READ CheckerBOARD(Row, Col)
NEXT Col
NEXT Row
'In the above reading loop, we have to keep in mind that the DATA will be
'read in the same order as it appears in the program, first row first, then
'the second row, etc.. So we do "Row" as the outside loop and "Col" (column)
'as the inside loop: Row 1,-Col 1, 2, 3, 4, etc.. Row 2,-Col 1, 2, 3, 4,
'etc.. Take a second to see the logic of this reading loop.
'If you look at the DATA, you'll see that the bottom-right square is a 1
'(red). If you print CheckerBOARD(8, 8) you should get a 1, now.
'PRINT CheckerBOARD(8, 8) 'The output of this will be a 1.
'PRINT CheckerBOARD(1, 2) 'First row, second column; output is 0 (black).
'SO NOW WHAT?
'Let's imagine that you have two single game pieces. We give a blue
'piece a value of 10 and a white piece a value of 20. Whenever a piece is
'moved to a square, that square's value in the array is incremented by
'the value of the piece moved to it. Whenever a piece moves OFF a square,
'the square's value is decremented by the piece's value. If I told you that
'at some point in the game, CheckerBOARD(Row, Col) = 21, what information
'would you have?
'I'm sure you got it, but if not, check SUB Answer.
'GAMEPLAY
'During game play, there are two positions to be maintained for each game
'piece, whether it's the good guy or the bad guy. The first is it's x/y
'coordinates for purposes of drawing or erasing its image (usually PUT
'statements). The second is its location in the array.
'Let's say that our checkerboard on the screen is made up of squares 50 by
'50 pixels, -total image 400 by 400. Every time we increment the x of a
'piece by 50 pixels, for example (move right), we increment its column
'position in the array by 1. Whenever we draw the image at a new location,
'we also increment its new position in the array by its value. Conversely,
'whenever we erase its visual image from a previous location, we also
'decrement the corresponding value in the array.
'It is in this way that we can "test" for factors which affect the play of
'the game by simply accessing the array whenever a piece moves to that
'particular Row/Column. If for example we have placed (at random) a land
'mine on CheckerBOARD(3, 7) and a piece moves there,... BOOOOOOMMMMM!!!.
'The value of the land mine can be anything, as long as we know what the
'number means. For example, if a land mine is worth 100, then as long as
'the value of the square is >= 100, we know there's a mine there. It's fun
'to work out values that tell us all there is to know about a square. You
'can use MOD, integer division (\), etc. for testing purposes, giving you
'multiple circumstances expressed as a single value.
'GETTING STARTED
'Start simple, as with the checkerboard example and two game pieces. Locate
'one game piece at random. RANDOMIZE TIMER assures a different game each time:
'RANDOMIZE TIMER
'BlueMANRow = FIX(RND * 8) + 1 'See FIX in the Help/Index if you don't
'BlueMANCol = FIX(RND * 8) + 1 'understand its use.
'CheckerBOARD(BlueMANRow, BlueMANCol) = CheckerBOARD(BlueMANRow, BlueMANCol) + 10
'Notice that we did not merely assign the value of the blue game piece to the
'square, -a common error. Instead, we said that WHATEVER the current value
'of the square, we want it increased by 10. So if the square was worth 1, it
'is now worth 11. If it was worth 0, it is now worth 10. If it was a red
'square with a land mine on it, it is now worth 111.
'Use the arrow keys to move the white game piece. What follows is a basic
'game-play loop. All game events and INPUT are inside the outer DO/LOOP:
'DO
'DO
'Ky$ = INKEY$
'LOOP WHILE Ky$ = "" 'Wait for key to be pressed
'RowINCREMENT = 0: ColINCREMENT = 0 'Reset increments to zero
'SELECT CASE Ky$
' CASE CHR$(0) + "H" 'Up arrow key
' CASE CHR$(0) + "P" 'Down arrow key
' CASE CHR$(0) + "K" 'Left arrow key
' CASE CHR$(0) + "M" 'Right arrow key
' CASE CHR$(27) 'Escape key (end at any time)
' SYSTEM
'END SELECT
'LOOP
'ORDER OF EVENTS
'First, we set the increments/decrements based on the key press for
'row/column, checking first to determine if the move is legal:
'Example, up arrow is pressed:
'CASE CHR$(0) + "H" 'Up arrow key
' IF WhiteMANRow > 1 THEN RowINCREMENT = -1 ELSE RowINCREMENT = 0
' (Otherwise you might fall off the checkerboard!)
'Second, following the arrow key SELECT CASE, check the value of the square
'you've just chosen to move to. If it's value tells you that the blue game
'piece is on it, reset the INCREMENT values to 0.
'IF CheckerBOARD(WhiteMANRow + RowINCREMENT, WhiteMANCol + ColINCREMENT) > 1 THEN
' RowINCREMENT = 0
' ColINCREMENT = 0
'END IF
'In more complex programs, it is in this preceding section that all
'circumstances would be tested for and game play altered accordingly,
'possibly involving sub program calls, etc.. Normally, SELECT CASE would
'be used since a great many values would have to be tested for and SELECT
'CASE is faster for this type of multiple option checking.
'And now, you execute the move (this section of code will not affect
'anything if the increment values haven't been altered).
'1.) Erase game piece image at previous location and decrement the value of
' CheckerBOARD(WhiteMANRow, WhiteMANCol), accordingly. This is possible
' because we have not yet altered the row/column, x/y coordinates, so
' they still represent the game piece's old position. All we've done at
' this point is assign values to RowINCREMENT and ColINCREMENT.
'2.) Increment the row/column of the game piece as well as its x/y values:
' WhiteMANRow = WhiteMANRow + RowINCREMENT
' WhiteMANCol = WhiteMANCol + ColINCREMENT
' WhiteMANy = WhiteMANy + RowINCREMENT * 50
' WhiteMANx = WhiteMANx + ColINCREMENT * 50
' (It doesn't matter what these increments are, plus or minus, value or
' no value. They will automatically provide the correct x/y changes.
' you might take a moment to see the logic of these statements before
' moving on).
'3.) Draw game piece at the new location and increment the corresponding
' element in the array:
' CheckerBOARD(WhiteMANRow, WhiteMANCol) = CheckerBOARD(WhiteMANRow, WhiteMANCol) + 20
'SUMMING UP...
'The game "Checked.BAS" is the finished version of this game. You should,
'however, see if you can work it out on your own before looking at that game.
'If you're stumped, by all means, check it out.
'If your little game is successful, you should be able to move your game
'piece anywhere on the board without going off the edge, and whenever you
'encounter the other piece on its randomly-selected square, you should be
'prevented from moving there.
'I've included a checkerboard graphic in SCREEN 12 that you can use to
'get you started. Copy and paste the BOARD sub to use it (just press F5.
'to see it). See this sub also for x/y coordinates to get you started
'drawing the simple blue/white game pieces. Since these images ARE simple,
'you might just use CIRCLE and PAINT statements for erasing and
'drawing images (keep in mind that you can check for the square's color
'when erasing by checking CheckerBOARD(Row, Col). Square_value MOD 10 = 1
'means a red square and square_value MOD 10 = 0 means black, since both
'game pieces as well as a land mine (your option) MOD 10 = 0).
'
' Good luck!
' Bob Seguin
'
'-----------------------------------------------------------------------------
SCREEN 12
OUT &H3C8, 2 'Color 2 set to a darker green for background
OUT &H3C9, 0
OUT &H3C9, 30
OUT &H3C9, 0
OUT &H3C8, 4 'Color 4 set to a brighter red
OUT &H3C9, 63
OUT &H3C9, 0
OUT &H3C9, 0
BOARD 'Call to sub program
a$ = INPUT$(1) 'Wait for a key press
END
DEFSNG A-Z
SUB Answer
'A red square with a white game piece on it.
END SUB
DEFINT A-Z
SUB BOARD
PAINT (0, 0), 2
LINE (7, 7)-(633, 473), 8, B
LINE (10, 10)-(629, 469), 8, B
LINE (118, 35)-(527, 444), 8, BF
LINE (118, 35)-(527, 444), 0, B
FOR x = 123 TO 473 STEP 50
Col = Col + 1
FOR y = 40 TO 390 STEP 50
Row = Row + 1
LINE (x, y)-(x + 50, y + 50), 14, B
IF (Col + Row) MOD 2 THEN Colr = 0 ELSE Colr = 4
PAINT (x + 12, y + 12), Colr, 14
NEXT y
NEXT x
CIRCLE (148, 65), 20, 15 '148:65 are top row, first column center.
PAINT (148, 65), 15
CheckerBOARD(1, 1) = CheckerBOARD(1, 1) + 20
CIRCLE (198, 65), 20, 9 '198:65 are top row, second column center, etc.
PAINT (198, 65), 9
CheckerBOARD(1, 2) = CheckerBOARD(1, 2) + 10
END SUB
|
|
|
|
|
![[Image: Screenshot-656.png]](https://i.ibb.co/ftfTQDs/Screenshot-656.png)
![[Image: Screenshot-587.png]](https://i.ibb.co/VC6XQFt/Screenshot-587.png)
![[Image: Screenshot-654.png]](https://i.ibb.co/cYzS4B6/Screenshot-654.png)
.![[Image: Screenshot-653.png]](https://i.ibb.co/7b5ypxN/Screenshot-653.png)
