| Welcome, Guest |
You have to register before you can post on our site.
|
| Latest Threads |
MBA Assignment Help in Du...
Forum: General Discussion
Last Post: hafsahomar
06-11-2025, 07:05 AM
» Replies: 0
» Views: 11
|
лучшие песни медляки слуш...
Forum: Petr
Last Post: WillieTop
06-08-2025, 02:21 AM
» Replies: 0
» Views: 24
|
пинк слушать онлайн беспл...
Forum: SMcNeill
Last Post: WillieTop
06-08-2025, 02:20 AM
» Replies: 0
» Views: 22
|
скачать музыку российскую...
Forum: madscijr
Last Post: WillieTop
06-08-2025, 02:18 AM
» Replies: 0
» Views: 23
|
нежная музыка mp3 скачать
Forum: Keybone
Last Post: WillieTop
06-08-2025, 02:17 AM
» Replies: 0
» Views: 21
|
лучшая песня слушать онла...
Forum: bplus
Last Post: WillieTop
06-08-2025, 02:16 AM
» Replies: 0
» Views: 24
|
пикник слушать онлайн луч...
Forum: Spriggsy
Last Post: WillieTop
06-08-2025, 02:15 AM
» Replies: 0
» Views: 22
|
какая сейчас популярная м...
Forum: RhoSigma
Last Post: WillieTop
06-08-2025, 02:14 AM
» Replies: 0
» Views: 18
|
хит лета 2019 музыка на т...
Forum: Christmas Code
Last Post: WillieTop
06-08-2025, 02:12 AM
» Replies: 0
» Views: 25
|
бесплатная музыка mp3 рег...
Forum: Works in Progress
Last Post: WillieTop
06-08-2025, 02:11 AM
» Replies: 0
» Views: 17
|
|
|
| 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
|
|
|
|
| Clock - An Analog Clock with Alarm. |
|
Posted by: Pete - 04-27-2022, 06:09 PM - Forum: TheBOB
- No Replies
|
|
Clock.bas by Bob Seguin.
![[Image: Screenshot-650.png]](https://i.ibb.co/kHDpZjn/Screenshot-650.png)
Description: An analog clock with a timer alarm setting.
Code: (Select All) '*************************************************
'
'------------ C L O C K . B A S ------------------
'
'------- Freeware by Bob Seguin - 2001 -----------
'
'- An analog/digital clock with countdown timer -
'
'*************************************************
_TITLE "Clock.bas by Bob Seguin"
DEFINT A-Z
DECLARE SUB Digital (x, y, Num$)
CONST Degree! = 3.14159 / 180
DIM FaceBOX(6500)
DIM TickBOX(6500)
DIM SHARED DigitBOX(1 TO 400)
SCREEN 12
GOSUB GetDIGITS
OUT &H3C8, 0
OUT &H3C9, 0
OUT &H3C9, 0
OUT &H3C9, 12
OUT &H3C8, 1
OUT &H3C9, 16
OUT &H3C9, 18
OUT &H3C9, 22
OUT &H3C8, 4
OUT &H3C9, 63
OUT &H3C9, 0
OUT &H3C9, 0
ON TIMER(1) GOSUB Clock
TIMER ON
'Analog clock graphic
LINE (235, 125)-(405, 311), 1, B
LINE (240, 130)-(400, 279), 1, BF
CIRCLE (320, 210), 60, 7
PAINT STEP(0, 0), 7
CIRCLE (320, 210), 63, 7
CIRCLE STEP(0, 0), 2, 0
PAINT STEP(0, 0), 0
LINE (240, 282)-(400, 306), 1, BF
LINE (240, 282)-(400, 306), 1, BF
LINE (290, 285)-(350, 303), 0, BF
LINE (310, 291)-(310, 292), 10, B
LINE (330, 291)-(330, 292), 10, B
LINE (310, 296)-(310, 297), 10, B
LINE (330, 296)-(330, 297), 10, B
LINE (10, 10)-(629, 469), 8, B
LINE (15, 15)-(624, 464), 8, B
COLOR 8
LOCATE 24, 23: PRINT "PRESS S TO ENTER COUNTDOWN MINUTES"
LOCATE 26, 32: PRINT "PRESS [ESC] TO QUIT"
FOR n = 6 TO 360 STEP 6
Adjacent = 320 + 55 * COS(n * Degree!)
Opposite = 210 - 55 * SIN(n * Degree!)
IF n MOD 30 = 0 THEN
CIRCLE (Adjacent, Opposite), 2, 0: PAINT STEP(0, 0), 0
ELSE
CIRCLE (Adjacent, Opposite), 1, 15
END IF
NEXT n
GET (240, 130)-(400, 279), FaceBOX()
GET (240, 130)-(400, 279), TickBOX()
GOSUB Clock
DO
Count$ = UCASE$(INKEY$)
IF Count$ = "S" THEN
DO
COLOR 11
LOCATE 3, 5
INPUT "Enter minutes (Maximum 720): ", CountDOWN$
LOCATE 3, 5: PRINT SPACE$(60)
LOOP UNTIL VAL(CountDOWN$) AND VAL(CountDOWN$) <= 720
CountDOWN% = VAL(CountDOWN$)
Hr$ = MID$(TIME$, 1, 2)
Mt$ = MID$(TIME$, 4, 2)
Sc$ = MID$(TIME$, 7, 2)
Hr% = 0: Hr2% = 0: Mt% = 0
Hr% = VAL(Hr$)
Mt% = VAL(Mt$)
Mt% = Mt% + CountDOWN%
IF Mt% > 59 THEN
Hr2% = Mt% \ 60
Mt% = Mt% MOD 60
END IF
Hr% = Hr% + Hr2%
IF Hr% > 24 THEN Hr% = Hr% - 24
Hr$ = LTRIM$(STR$(Hr%))
Mt$ = LTRIM$(STR$(Mt%))
IF Hr% < 10 THEN Hr$ = "0" + Hr$
IF Hr% = 24 THEN Hr$ = "00"
IF Mt% < 10 THEN Mt$ = "0" + Mt$
CountDOWN$ = Hr$ + ":" + Mt$ + ":" + Sc$
LOCATE 28, 27: COLOR 5: PRINT "ALARM WILL SOUND AT: "; CountDOWN$
END IF
LOOP UNTIL Count$ = CHR$(27)
SYSTEM
Clock: 'update digital clock
PUT (240, 130), FaceBOX(), PSET
Hour$ = MID$(TIME$, 1, 2)
Minute$ = MID$(TIME$, 4, 2)
Second$ = MID$(TIME$, 7, 2)
Digital 294, 289, Hour$
Digital 314, 289, Minute$
Digital 334, 289, Second$
Hours = VAL(Hour$)
Minutes = VAL(Minute$)
Seconds = VAL(Second$)
nMIN = Minutes * 6 - 90
nSEC = Seconds * 6 - 90
nHRS = Hours * 30 - 90 + Minutes / 2
IF OldMIN <> nMIN THEN 'change minutes/hours
PUT (240, 130), TickBOX(), PSET
HAdjacent = 320 + 38 * COS(nHRS * Degree!)
HOpposite = 210 + 38 * SIN(nHRS * Degree!)
LINE (320, 210)-(HAdjacent, HOpposite), 0
MAdjacent = 320 + 50 * COS(nMIN * Degree!)
MOpposite = 210 + 50 * SIN(nMIN * Degree!)
LINE (320, 210)-(MAdjacent, MOpposite), 0
OldMIN = nMIN
GET (240, 130)-(400, 279), FaceBOX()
END IF
'change seconds
SAdjacent = 320 + 50 * COS(nSEC * Degree!)
SOpposite = 210 + 50 * SIN(nSEC * Degree!)
LINE (320, 210)-(SAdjacent, SOpposite), 4
IF TIME$ = CountDOWN$ THEN
PLAY "MBT120O3L32fA>fA<fA>fA<fA>fA<fA>fA<fA>fA"
LOCATE 28, 26: PRINT SPACE$(30);
END IF
RETURN
GetDIGITS:
MaxWIDTH = 70
MaxDEPTH = 10
x = 0: y = 0
DO
READ Count, Colr
FOR Reps = 1 TO Count
PSET (x, y), Colr
x = x + 1
IF x > MaxWIDTH THEN
x = 0
y = y + 1
END IF
NEXT Reps
LOOP UNTIL y > MaxDEPTH
Index = 1
FOR x = 0 TO 63 STEP 7
GET (x, 0)-(x + 6, 10), DigitBOX(Index)
Index = Index + 40
NEXT x
LINE (0, 0)-(70, 10), 0, BF
RETURN
DATA 1,0,4,10,10,0,4,10,3,0,4,10,10,0,4,10,3,0,4,10,3,0,4,10
DATA 3,0,4,10,3,0,4,10,3,0,1,10,4,0,1,10,6,0,1,10,6,0,1,10
DATA 6,0,1,10,1,0,1,10,4,0,1,10,1,0,1,10,6,0,1,10,11,0,1,10
DATA 1,0,1,10,4,0,1,10,1,0,1,10,4,0,1,10,2,0,1,10,4,0,1,10
DATA 6,0,1,10,6,0,1,10,6,0,1,10,1,0,1,10,4,0,1,10,1,0,1,10
DATA 6,0,1,10,11,0,1,10,1,0,1,10,4,0,1,10,1,0,1,10,4,0,1,10
DATA 2,0,1,10,4,0,1,10,6,0,1,10,6,0,1,10,6,0,1,10,1,0,1,10
DATA 4,0,1,10,1,0,1,10,6,0,1,10,11,0,1,10,1,0,1,10,4,0,1,10
DATA 1,0,1,10,4,0,1,10,2,0,1,10,4,0,1,10,6,0,1,10,6,0,1,10
DATA 6,0,1,10,1,0,1,10,4,0,1,10,1,0,1,10,6,0,1,10,11,0,1,10
DATA 1,0,1,10,4,0,1,10,1,0,1,10,4,0,1,10,17,0,4,10,3,0,4,10
DATA 3,0,4,10,3,0,4,10,3,0,4,10,10,0,4,10,3,0,4,10,3,0,1,10
DATA 4,0,1,10,6,0,1,10,1,0,1,10,11,0,1,10,6,0,1,10,6,0,1,10
DATA 1,0,1,10,4,0,1,10,6,0,1,10,1,0,1,10,4,0,1,10,6,0,1,10
DATA 2,0,1,10,4,0,1,10,6,0,1,10,1,0,1,10,11,0,1,10,6,0,1,10
DATA 6,0,1,10,1,0,1,10,4,0,1,10,6,0,1,10,1,0,1,10,4,0,1,10
DATA 6,0,1,10,2,0,1,10,4,0,1,10,6,0,1,10,1,0,1,10,11,0,1,10
DATA 6,0,1,10,6,0,1,10,1,0,1,10,4,0,1,10,6,0,1,10,1,0,1,10
DATA 4,0,1,10,6,0,1,10,2,0,1,10,4,0,1,10,6,0,1,10,1,0,1,10
DATA 11,0,1,10,6,0,1,10,6,0,1,10,1,0,1,10,4,0,1,10,6,0,1,10
DATA 1,0,1,10,4,0,1,10,6,0,1,10,3,0,4,10,10,0,4,10,3,0,4,10
DATA 10,0,4,10,3,0,4,10,10,0,4,10,3,0,4,10,3,0
SUB Digital (x, y, Num$)
FOR Digit = 1 TO LEN(Num$)
Digit$ = MID$(Num$, Digit, 1)
DigitINDEX = VAL(Digit$) * 40 + 1
PUT (x, y), DigitBOX(DigitINDEX), PSET
x = x + DigitBOX(DigitINDEX)
NEXT Digit
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)
![[Image: Screenshot-558.png]](https://i.ibb.co/744qMmq/Screenshot-558.png)
![[Image: Screenshot-578.png]](https://i.ibb.co/hL3tq2R/Screenshot-578.png)
