| Welcome, Guest |
You have to register before you can post on our site.
|
|
|
| wrangling chatgpt to get it to write a more complex program - Spacewar! |
|
Posted by: madscijr - 12-16-2022, 09:18 PM - Forum: General Discussion
- Replies (8)
|
 |
So the sky's the limit, right? Why not shoot for the moon, or at least Space!
Here's what happend when I asked it to write Spacewar!
Code: (Select All) Can you write a 2 player Spacewar! game in QB64 where the players are controlled with the keyboard, (player 1 controls are: up arrow = thrust, down arrow = warp, left arrow = rotate left, right arrow = rotate right, ENTER = fire; player 2 controls are: A = rotate left, D = rotate right, S = warp, W = thrust, E = fire), and includes 2 additional computer controlled players, and 2 suns?
Sure! Here is a simple Spacewar! game in QB64 that allows two players to control their ships with the keyboard, and includes two additional computer-controlled players and two suns:
' Declare constants for the screen width and height
CONST SCREEN_WIDTH = 640
CONST SCREEN_HEIGHT = 480
' Declare constants for the player colors
CONST PLAYER_1_COLOR = 15
CONST PLAYER_2_COLOR = 11
CONST CPU_PLAYER_COLOR = 7
' Declare constants for the sun colors
CONST SUN_1_COLOR = 12
CONST SUN_2_COLOR = 14
' Declare constants for the player controls
CONST PLAYER_1_UP = 72
CONST PLAYER_1_DOWN = 80
CONST PLAYER_1_LEFT = 75
CONST PLAYER_1_RIGHT = 77
CONST PLAYER_1_FIRE = 13
CONST PLAYER_2_UP = 87
CONST PLAYER_2_DOWN = 83
CONST PLAYER_2_LEFT = 65
CONST PLAYER_2_RIGHT = 68
CONST PLAYER_2_FIRE = 69
' Declare constants for the game states
CONST GAME_STATE_INITIALIZING = 0
CONST GAME_STATE_PLAYING = 1
CONST GAME_STATE_PAUSED = 2
CONST GAME_STATE_OVER = 3
' Declare variables for the game state and the player scores
DIM GameState AS INTEGER
DIM Player1Score AS INTEGER
DIM Player2Score AS INTEGER
' Declare a type for the players
TYPE Player
X AS SINGLE
Y AS SINGLE
Angle AS SINGLE
Speed AS SINGLE
RotationSpeed AS SINGLE
Color AS INTEGER
IsComputerControlled AS BOOLEAN
END TYPE
' Declare variables for the players
DIM Player1 AS Player
DIM Player2 AS Player
DIM CPUPlayer1 AS Player
DIM CPUPlayer2 AS Player
' Declare a type for the suns
TYPE Sun
X AS SINGLE
Y AS SINGLE
Mass AS SINGLE
Color AS INTEGER
END TYPE
' Declare variables for the suns
DIM Sun1 AS Sun
DIM Sun2 AS Sun
' Initialize the game
SUB InitializeGame
' Set the game state to initializing
GameState = GAME_STATE_INITIALIZING
' Initialize the player scores
Player1Score = 0
Player2Score = 0
' Initialize player 1
Player1.X = SCREEN_WIDTH / 4
Player1.Y = SCREEN_HEIGHT / 2
Player1.Angle = 0
Player1.Speed = 0
Player1.RotationSpeed = 0
Player1.Color = PLAYER_1_COLOR
Player1.IsComputerControlled = False
' Initialize player 2
Player2.X = SCREEN_WIDTH * 3 / 4
Player2.Y = SCREEN_HEIGHT / 2
Player2.Angle = 180
Player2.Speed = 0
Player2.R
Wait! You're not done! What if we ask it to finish? We'll even say "please"!
Code: (Select All) Would you please show the rest of the program?
Certainly! Here is the rest of the Spacewar! game in QB64 that allows two players to control their ships with the keyboard, and includes two additional computer-controlled players and two suns:
' Update the player's position and angle based on their speed and rotation speed
SUB UpdatePlayer(Player AS Player)
' Update the player's angle
Player.Angle = Player.Angle + Player.RotationSpeed
' Keep the angle between 0 and 360 degrees
IF Player.Angle < 0 THEN
Player.Angle = Player.Angle + 360
ELSEIF Player.Angle > 360 THEN
Player.Angle = Player.Angle - 360
END IF
' Calculate the player's new position based on their speed and angle
Player.X = Player.X + Player.Speed * COS(Player.Angle)
Player.Y = Player.Y + Player.Speed * SIN(Player.Angle)
' Keep the player within the screen bounds
IF Player.X < 0 THEN
Player.X = 0
ELSEIF Player.X > SCREEN_WIDTH THEN
Player.X = SCREEN_WIDTH
END IF
IF Player.Y < 0 THEN
Player.Y = 0
ELSEIF Player.Y > SCREEN_HEIGHT THEN
Player.Y = SCREEN_HEIGHT
END IF
END SUB
' Update the player's speed based on their thrust
SUB UpdatePlayerThrust(Player AS Player, IsThrusting AS BOOLEAN)
' If the player is thrusting, increase their speed
IF IsThrusting THEN
Player.Speed = Player.Speed + 0.1
' If the player is not thrusting, decrease their speed
ELSE
Player.Speed = Player.Speed - 0.1
END IF
' Limit the player's speed
IF Player.Speed < 0 THEN
Player.Speed = 0
ELSEIF Player.Speed > 5 THEN
Player.Speed = 5
END IF
END SUB
' Update the player's rotation speed based on their rotation
SUB UpdatePlayerRotation(Player AS Player, IsRotatingLeft AS BOOLEAN, IsRotatingRight AS BOOLEAN)
' If the player is rotating left, increase their rotation speed
IF Is
OK, it remembered what we asked it, and sort of continued, but not where it left off!
Shall we persevere?
Code: (Select All) Would you please show the rest of the program?
Certainly! Here is the rest of the Spacewar! game in QB64 that allows two players to control their ships with the keyboard, and includes two additional computer-controlled players and two suns:
' Update the computer-controlled players
SUB UpdateCPUPlayers
' Update player 1
UpdateCPUPlayer(CPUPlayer1)
' Update player 2
UpdateCPUPlayer(CPUPlayer2)
END SUB
' Update a computer-controlled player
SUB UpdateCPUPlayer(Player AS Player)
' Calculate the distance to player 1
DX = Player1.X - Player.X
DY = Player1.Y - Player.Y
DistanceToPlayer1 = SQR(DX * DX + DY * DY)
' Calculate the distance to player 2
DX = Player2.X - Player.X
DY = Player2.Y - Player.Y
DistanceToPlayer2 = SQR(DX * DX + DY * DY)
' Calculate the distance to the nearest sun
DX = Sun1.X - Player.X
DY = Sun1.Y - Player.Y
DistanceToSun1 = SQR(DX * DX + DY * DY)
DX = Sun2.X - Player.X
DY = Sun2.Y - Player.Y
DistanceToSun2 = SQR(DX * DX + DY * DY)
If DistanceToSun1 < DistanceToSun2 Then
DistanceToNearestSun = DistanceToSun1
Else
DistanceToNearestSun = DistanceToSun2
End If
' If the player is far from the other players and the suns, move randomly
If DistanceToPlayer1 > 100 And DistanceToPlayer2 > 100 And DistanceToNearestSun > 100 Then
' Choose a random angle and set the player's rotation speed
TargetAngle = RND * 360
If TargetAngle > Player.Angle Then
Player.RotationSpeed = 0.5
Else
Player.RotationSpeed = -0.5
End If
' If the player is close to a player, move towards them
ElseIf DistanceToPlayer1 < DistanceToPlayer2 Then
' Calculate the angle to player 1 and set the player's rotation speed
TargetAngle = ATN2(DY, DX) * 180 / PI
If TargetAngle > Player.Angle Then
Player.RotationSpeed = 0.5
Else
Player.RotationSpeed = -0.5
End If
Else
' Calculate the angle to player 2 and set the player's rotation speed
TargetAngle = ATN2(DY, DX) * 180 / PI
If TargetAngle > Player.Angle Then
Player.RotationSpeed = 0.5
Else
Don't leave me hanging, chatgpt!
Code: (Select All) Would you please show the rest of the program?
Certainly! Here is the rest of the Spacewar! game in QB64 that allows two players to control their ships with the keyboard, and includes two additional computer-controlled players and two suns:
' Update the player's speed based on the gravitational pull of the suns
SUB UpdatePlayerGravity(Player AS Player)
' Calculate the distance and angle to sun 1
DX = Sun1.X - Player.X
DY = Sun1.Y - Player.Y
DistanceToSun1 = SQR(DX * DX + DY * DY)
AngleToSun1 = ATN2(DY, DX) * 180 / PI
' Calculate the distance and angle to sun 2
DX = Sun2.X - Player.X
DY = Sun2.Y - Player.Y
DistanceToSun2 = SQR(DX * DX + DY * DY)
AngleToSun2 = ATN2(DY, DX) * 180 / PI
' Calculate the gravitational force from sun 1
GravitationalForce1 = Sun1.Mass / DistanceToSun1
' Calculate the gravitational force from sun 2
GravitationalForce2 = Sun2.Mass / DistanceToSun2
' Calculate the total gravitational force
TotalGravitationalForce = GravitationalForce1 + GravitationalForce2
' Calculate the gravitational acceleration
GravitationalAcceleration = TotalGravitationalForce / Player.Mass
' Calculate the gravitational speed
GravitationalSpeed = GravitationalAcceleration * 0.1
' Calculate the new speed based on the gravitational speed
NewSpeed = Player.Speed + GravitationalSpeed
' Limit the player's speed
If NewSpeed < 0 Then
NewSpeed = 0
ElseIf NewSpeed > 5 Then
NewSpeed = 5
End If
' Set the player's speed
Player.Speed = NewSpeed
END SUB
' Draw a player
SUB DrawPlayer(Player AS Player)
' Calculate the points of the triangle representing the player's ship
X1 = Player.X + 5 * COS
Aye aye aye! It doesn't seem to always know how to (or want to) continue from where it left off, does it?
What if we're more specific?
Code: (Select All) would you please show the full SUB UpdatePlayerRotation ?
Certainly! Here is the full UpdatePlayerRotation subroutine in the Spacewar! game in QB64 that allows two players to control their ships with the keyboard, and includes two additional computer-controlled players and two suns:
' Update the player's rotation speed based on their rotation
SUB UpdatePlayerRotation(Player AS Player, IsRotatingLeft AS BOOLEAN, IsRotatingRight AS BOOLEAN)
' If the player is rotating left, increase their rotation speed
IF IsRotatingLeft THEN
Player.RotationSpeed = Player.RotationSpeed + 0.5
' If the player is rotating right, decrease their rotation speed
ELSEIF IsRotatingRight THEN
Player.RotationSpeed = Player.RotationSpeed - 0.5
' If the player is not rotating, decrease their rotation speed
ELSE
Player.RotationSpeed = Player.RotationSpeed - 0.1
END IF
' Limit the player's rotation speed
IF Player.RotationSpeed < -2 THEN
Player.RotationSpeed = -2
ELSEIF Player.RotationSpeed > 2 THEN
Player.RotationSpeed = 2
END IF
END SUB
This subroutine updates the player's rotation speed based on whether they are rotating left, rotating right, or not rotating at all. If the player is rotating left, their rotation speed is increased. If the player is rotating right, their rotation speed is decreased. If the player is not rotating, their rotation speed is decreased. The rotation speed is limited to a maximum of 2 and a minimum of -2.
I hope this helps! Let me know if you have any questions or if you need further assistance.
Maybe being specific is the key? Let's try to get it to spit out the rest of "teh codez"!
Code: (Select All) Thank You. Would you please show the full SUB UpdateCPUPlayer ?
Certainly! Here is the full UpdateCPUPlayer subroutine in the Spacewar! game in QB64 that allows two players to control their ships with the keyboard, and includes two additional computer-controlled players and two suns:
' Update a computer-controlled player
SUB UpdateCPUPlayer(Player AS Player)
' Calculate the distance to player 1
DX = Player1.X - Player.X
DY = Player1.Y - Player.Y
DistanceToPlayer1 = SQR(DX * DX + DY * DY)
' Calculate the distance to player 2
DX = Player2.X - Player.X
DY = Player2.Y - Player.Y
DistanceToPlayer2 = SQR(DX * DX + DY * DY)
' Calculate the distance to the nearest sun
DX = Sun1.X - Player.X
DY = Sun1.Y - Player.Y
DistanceToSun1 = SQR(DX * DX + DY * DY)
DX = Sun2.X - Player.X
DY = Sun2.Y - Player.Y
DistanceToSun2 = SQR(DX * DX + DY * DY)
If DistanceToSun1 < DistanceToSun2 Then
DistanceToNearestSun = DistanceToSun1
Else
DistanceToNearestSun = DistanceToSun2
End If
' If the
Argh. Why does it output in such small chunks?? How useless is that?!
But we must see this thing through!
Code: (Select All) would you please show the rest of the routine?
Certainly! Here is the rest of the UpdateCPUPlayer subroutine in the Spacewar! game in QB64 that allows two players to control their ships with the keyboard, and includes two additional computer-controlled players and two suns:
' If the player is far from the other players and the suns, move randomly
If DistanceToPlayer1 > 100 And DistanceToPlayer2 > 100 And DistanceToNearestSun > 100 Then
' Choose a random angle and set the player's rotation speed
TargetAngle = RND * 360
If TargetAngle > Player.Angle Then
Player.RotationSpeed = 0.5
Else
Player.RotationSpeed = -0.5
End If
' If the player is close to a player, move towards them
ElseIf DistanceToPlayer1 < DistanceToPlayer2 Then
' Calculate the angle to player 1 and set the player's rotation speed
TargetAngle = ATN2(DY, DX) * 180 / PI
If TargetAngle > Player.Angle Then
Player.RotationSpeed = 0.5
Else
Player.RotationSpeed = -0.5
End If
Else
' Calculate the angle to player 2 and set the player's rotation speed
TargetAngle = ATN2(DY, DX) * 180 / PI
If TargetAngle > Player.Angle Then
Player.RotationSpeed = 0.5
Else
Player.RotationSpeed = -0.5
End If
End If
' Set the player's thrust based on their distance to the nearest sun
If DistanceToNearestSun < 50 Then
Player.IsThrusting = False
Else
Player.IsThrusting = True
End If
END SUB
This subroutine updates the position and angle of a computer-controlled player based on their distance to the other players and the suns. If the player is far from the other players and the suns, they choose a random angle and rotate towards it. If the player is close to a player, they move towards them. If the player is close to a sun, they stop thrusting.
I hope this helps! Let me know if you have any questions or if you need further assistance.
OK then! We'll keep soldiering on, then...
Maybe the "p" word isn't enough, let's also be sure to say "thank you"!
Code: (Select All) Thank you. Would you please show the full SUB DrawPlayer?
Certainly! Here is the full DrawPlayer subroutine in the Spacewar! game in QB64 that allows two players to control their ships with the keyboard, and includes two additional computer-controlled players and two suns:
' Draw a player
SUB DrawPlayer(Player AS Player)
' Calculate the points of the triangle representing the player's ship
X1 = Player.X + 5 * COS(Player.Angle)
Y1 = Player.Y + 5 * SIN(Player.Angle)
X2 = Player.X + 5 * COS(Player.Angle + 120)
Y2 = Player.Y + 5 * SIN(Player.Angle + 120)
X3 = Player.X + 5 * COS(Player.Angle + 240)
Y3 = Player.Y + 5 * SIN(Player.Angle + 240)
' Draw the triangle representing the player's ship
LINE (X1, Y1)-(X2, Y2), Player.Color
LINE (X2, Y2)-(X3, Y3), Player.Color
LINE (X3, Y3)-(X1, Y1), Player.Color
' If the player is thrusting, draw a flame behind their ship
If Player.IsThrusting Then
LINE (X2, Y2)-(X2 + 2 * COS(Player.Angle + 180), Y2 + 2 * SIN(Player.Angle + 180)), Player.Color
LINE (X3, Y3)-(X3 + 2 * COS(Player.Angle + 180), Y3 + 2 * SIN(Player.Angle + 180)), Player.Color
End If
END SUB
This subroutine draws a triangle representing the player's ship and, if the player is thrusting, a flame behind their ship. The points of the triangle are calculated using the player's angle and the coordinates of the player's ship. The triangle is then drawn using the player's color. If the player is thrusting, two lines are drawn behind the triangle to represent the flame.
I hope this helps! Let me know if you have any questions or if you need further assistance.
And on...
Code: (Select All) Thank you. Would you please show the rest of the program?
Certainly! Here is the rest of the Spacewar! game in QB64 that allows two players to control their ships with the keyboard, and includes two additional computer-controlled players and two suns:
' Initialize the players
Player1.X = 100
Player1.Y = 100
Player1.Angle = 0
Player1.RotationSpeed = 0
Player1.Speed = 0
Player1.IsThrusting = False
Player1.Mass = 10
Player1.Color = RGB(255, 0, 0)
Player2.X = 200
Player2.Y = 100
Player2.Angle = 0
Player2.RotationSpeed = 0
Player2.Speed = 0
Player2.IsThrusting = False
Player2.Mass = 10
Player2.Color = RGB(0, 255, 0)
CPUPlayer1.X = 100
CPUPlayer1.Y = 200
CPUPlayer1.Angle = 0
CPUPlayer1.RotationSpeed = 0
CPUPlayer1.Speed = 0
CPUPlayer1.IsThrusting = False
CPUPlayer1.Mass = 10
CPUPlayer1.Color = RGB(0, 0, 255)
CPUPlayer2.X = 200
CPUPlayer2.Y = 200
CPUPlayer2.Angle = 0
CPUPlayer2.RotationSpeed = 0
CPUPlayer2.Speed = 0
CPUPlayer2.IsThrusting = False
CPUPlayer2.Mass = 10
CPUPlayer2.Color = RGB(255, 255, 0)
' Initialize the suns
Sun1.X = 150
Sun1.Y = 150
Sun1.Mass = 1000
Sun2.X = 250
Sun2.Y = 150
Sun2.Mass = 1000
' Set the screen update rate
SCREEN UpdateRate(30)
' Set the window title
WINDOW Title$ = "Spacewar!"
' Set the window size
WINDOW Width = 320, Height = 240
DO
' Clear the screen
CLS
' Update the players
UpdatePlayerRotation(Player1, GetKeyState(VK_LEFT) AND 1, GetKeyState(VK_RIGHT) AND 1)
UpdatePlayerRotation(Player2, GetKeyState(VK_A) AND 1, GetKeyState(VK_D) AND 1)
UpdatePlayerThrust(Player1, GetKeyState(VK_UP) AND 1)
UpdatePlayerThrust(Player2, GetKeyState(VK_W) AND 1)
UpdatePlayerPosition(Player1)
UpdatePlayerPosition(Player2)
UpdateCPUPlayers
UpdatePlayerGravity(Player1)
UpdatePlayerGravity(Player2)
UpdatePlayerGravity(CPUPlayer1)
UpdatePlayerGravity(CPUPlayer2)
' Draw the players
DrawPlayer(Player1)
DrawPlayer(Player2)
DrawPlayer(CPUPlayer1)
DrawPlayer(CPUPlayer2)
' Draw the suns
CIRCLE (Sun1.X, Sun1.Y), 10, RGB(255, 255, 0)
CIRCLE (Sun2.X, Sun2.Y), 10, RGB(255, 255, 0)
' Check for player collisions
If PlayerCollision(Player1, Player2) Then
' End the game
OK, now it's initializing values, this looks like the main (global) code.
Can we get the rest out of this thing?
What if we're specific about telling it to NOT STOP until it's DONE?
Code: (Select All) Thank you. Would you please show the rest of the program? Don't stop until you have shown the whole thing.
Certainly! Here is the rest of the Spacewar! game in QB64 that allows two players to control their ships with the keyboard, and includes two additional computer-controlled players and two suns:
' End the game
EXIT DO
End If
If PlayerCollision(Player1, CPUPlayer1) Then
' End the game
EXIT DO
End If
If PlayerCollision(Player1, CPUPlayer2) Then
' End the game
EXIT DO
End If
If PlayerCollision(Player2, CPUPlayer1) Then
' End the game
EXIT DO
End If
If PlayerCollision(Player2, CPUPlayer2) Then
' End the game
EXIT DO
End If
' Check for player and sun collisions
If PlayerSunCollision(Player1, Sun1) Then
' End the game
EXIT DO
End If
If PlayerSunCollision(Player1, Sun2) Then
' End the game
EXIT DO
End If
If PlayerSunCollision(Player2, Sun1) Then
' End the game
EXIT DO
End If
If PlayerSunCollision(Player2, Sun2) Then
' End the game
EXIT DO
End If
If PlayerSunCollision(CPUPlayer1, Sun1) Then
' End the game
EXIT DO
End If
If PlayerSunCollision(CPUPlayer1, Sun2) Then
' End the game
EXIT DO
End If
If PlayerSunCollision(CPUPlayer2, Sun1) Then
' End the game
EXIT DO
End If
If PlayerSunCollision(CPUPlayer2, Sun2) Then
' End the game
EXIT DO
End If
' Check for player shots
If GetKeyState(VK_RETURN) AND 1 Then
Player1.Shots.AddNew
Player1.Shots(Player1.Shots.Count).X = Player1.X + 5 * COS(Player1.Angle)
Player1.Shots(Player1.Shots.Count).Y = Player1.Y + 5 * SIN(Player1.Angle)
Player1.Shots(Player1.Shots.Count).Angle = Player1.Angle
End If
If GetKeyState(VK_E) AND 1 Then
Player2.Shots.AddNew
Player2.Shots(Player2.Shots.Count).X = Player2.X + 5 * COS(Player2.Angle)
Player2.Shots(Player2.Shots.Count).Y =
A lot good that did!
Well, we've made it this far, let's see just how much more it will take to get the whole program!
Code: (Select All) Thank you. Would you please show the rest of the program?
Certainly! Here is the rest of the Spacewar! game in QB64 that allows two players to control their ships with the keyboard, and includes two additional computer-controlled players and two suns:
Player2.Shots(Player2.Shots.Count).Angle = Player2.Angle
End If
' Update and draw the player shots
For i = 0 To Player1.Shots.Count - 1
UpdateShot(Player1.Shots(i))
DrawShot(Player1.Shots(i))
Next
For i = 0 To Player2.Shots.Count - 1
UpdateShot(Player2.Shots(i))
DrawShot(Player2.Shots(i))
Next
' Check for shot and player collisions
For i = 0 To Player1.Shots.Count - 1
If ShotPlayerCollision(Player1.Shots(i), Player2) Then
' End the game
EXIT DO
End If
If ShotPlayerCollision(Player1.Shots(i), CPUPlayer1) Then
' End the game
EXIT DO
End If
If ShotPlayerCollision(Player1.Shots(i), CPUPlayer2) Then
' End the game
EXIT DO
End If
Next
For i = 0 To Player2.Shots.Count - 1
If ShotPlayerCollision(Player2.Shots(i), Player1) Then
' End the game
EXIT DO
End If
If ShotPlayerCollision(Player2.Shots(i), CPUPlayer1) Then
' End the game
EXIT DO
End If
If ShotPlayerCollision(Player2.Shots(i), CPUPlayer2) Then
' End the game
EXIT DO
End If
Next
' Check for shot and sun collisions
For i = 0 To Player1.Shots.Count - 1
If
If... if what you nincompoop?!?!?!
Let's not lose our temper, now.
We must stay calm, cool, and collected!
After all, there has to be at least one adult in the room!
Code: (Select All) Thank you. Would you please show the rest of the program? Don't stop until you have shown the whole thing.
Certainly! Here is the rest of the Spacewar! game in QB64 that allows two players to control their ships with the keyboard, and includes two additional computer-controlled players and two suns:
ShotSunCollision(Player1.Shots(i), Sun1) Then
Player1.Shots.Remove(i)
End If
If ShotSunCollision(Player1.Shots(i), Sun2) Then
Player1.Shots.Remove(i)
End If
Next
For i = 0 To Player2.Shots.Count - 1
If ShotSunCollision(Player2.Shots(i), Sun1) Then
Player2.Shots.Remove(i)
End If
If ShotSunCollision(Player2.Shots(i), Sun2) Then
Player2.Shots.Remove(i)
End If
Next
' Update the screen
SCREEN Update
LOOP
This is the main game loop that updates and draws the players, suns, and shots, and checks for collisions between them. The game ends when any two players collide, a player collides with a sun, or a shot hits a player or sun.
I hope this helps! Let me know if you have any questions or if you need further assistance.
Is it done? I've just about reached the end of my rope.
Can we just have it email the thing to us?
(After all, they have you give an email address when you sign up for a free account.)
Only one way to find out...
Code: (Select All) can you email me the entire program listing at my account's email address?
I'm sorry, but I am not able to send emails as I am just a text-based AI program. I do not have the ability to access or send emails. However, I can provide you with the full listing of the Spacewar! game in QB64 that allows two players to control their ships with the keyboard, and includes two additional computer-controlled players and two suns.
Here is the full listing of the program:
' Struct to represent a player
TYPE Player
X AS SINGLE
Y AS SINGLE
Angle AS SINGLE
RotationSpeed AS SINGLE
Speed AS SINGLE
IsThrusting AS BOOLEAN
Mass AS SINGLE
Color AS LONG
Shots AS Collection
END TYPE
' Struct to represent a shot
TYPE Shot
X AS SINGLE
Y AS SINGLE
Angle AS SINGLE
Speed AS SINGLE
Color AS LONG
END TYPE
' Struct to represent a sun
TYPE Sun
X AS SINGLE
Y AS SINGLE
Mass AS SINGLE
END TYPE
' Declare the players and suns
DIM Player1 AS Player
DIM Player2 AS Player
DIM CPUPlayer1 AS Player
DIM CPUPlayer2 AS Player
DIM Sun1 AS Sun
DIM Sun2 AS Sun
' Function to calculate the distance between two players
FUNCTION DistanceToPlayer(Player1 AS Player, Player2 AS Player) AS SINGLE
DistanceToPlayer = SQR((Player1.X
Guess not... But wait, is it starting over?
We've seen the Player and Sun UDTs already, but we haven't seen this Shot UDT before!
That's new - what gives?? Can we coax some more out of it?
Code: (Select All) go on
Certainly! Here is the rest of the Spacewar! game in QB64 that allows two players to control their ships with the keyboard, and includes two additional computer-controlled players and two suns:
- Player2.X) ^ 2 + (Player1.Y - Player2.Y) ^ 2)
END FUNCTION
' Function to check for a collision between two players
FUNCTION PlayerCollision(Player1 AS Player, Player2 AS Player) AS BOOLEAN
If DistanceToPlayer(Player1, Player2) < 10 Then
PlayerCollision = True
Else
PlayerCollision = False
End If
END FUNCTION
' Function to check for a collision between a player and a sun
FUNCTION PlayerSunCollision(Player AS Player, Sun AS Sun) AS BOOLEAN
If DistanceToPlayer(Player, Sun) < 10 Then
PlayerSunCollision = True
Else
PlayerSunCollision = False
End If
END FUNCTION
' Function to check for a collision between a shot and a player
FUNCTION ShotPlayerCollision(Shot AS Shot, Player AS Player) AS BOOLEAN
If DistanceToPlayer(Shot, Player) < 5 Then
ShotPlayerCollision = True
Else
ShotPlayerCollision = False
End If
END FUNCTION
' Function to check for a collision between a shot and a sun
FUNCTION ShotSunCollision(Shot AS Shot, Sun AS Sun) AS BOOLEAN
If DistanceToPlayer(Shot, Sun) < 5 Then
ShotSunCollision = True
Else
ShotSunCollision = False
End If
END FUNCTION
' Update a player's rotation
SUB UpdatePlayerRotation(Player AS Player, LeftKey AS BOOLEAN, RightKey AS BOOLEAN)
If LeftKey Then
Player.RotationSpeed = Player.RotationSpeed - 0.1
ElseIf RightKey Then
Player.RotationSpeed = Player.RotationSpeed + 0.1
Else
Player.RotationSpeed = Player.RotationSpeed * 0.9
End If
Player.Angle = Player.Angle + Player
Mmmmmkay, so is there an end to this?
We'll continue, as long as our sanity holds out!
Code: (Select All) do continue
Certainly! Here is the rest of the Spacewar! game in QB64 that allows two players to control their ships with the keyboard, and includes two additional computer-controlled players and two suns:
'.RotationSpeed
END SUB
' Update a player's thrust
SUB UpdatePlayerThrust(Player AS Player, UpKey AS BOOLEAN)
If UpKey Then
Player.IsThrusting = True
Player.Speed = Player.Speed + 0.1
Else
Player.IsThrusting = False
End If
END SUB
' Update a player's position based on their speed and angle
SUB UpdatePlayerPosition(Player AS Player)
Player.X = Player.X + Player.Speed * COS(Player.Angle)
Player.Y = Player.Y + Player.Speed * SIN(Player.Angle)
END SUB
' Update the computer-controlled players
SUB UpdateCPUPlayers
CPUPlayer1.Angle = ATN2(Player1.Y - CPUPlayer1.Y, Player1.X - CPUPlayer1.X)
CPUPlayer1.Speed = CPUPlayer1.Speed + 0.1
CPUPlayer1.X = CPUPlayer1.X + CPUPlayer1.Speed * COS(CPUPlayer1.Angle)
CPUPlayer1.Y = CPUPlayer1.Y + CPUPlayer1.Speed * SIN(CPUPlayer1.Angle)
CPUPlayer2.Angle = ATN2(Player2.Y - CPUPlayer2.Y, Player2.X - CPUPlayer2.X)
CPUPlayer2.Speed = CPUPlayer2.Speed + 0.1
CPUPlayer2.X = CPUPlayer2.X + CPUPlayer2.Speed * COS(CPUPlayer2.Angle)
CPUPlayer2.Y = CPUPlayer2.Y + CPUPlayer2.Speed * SIN(CPUPlayer2.Angle)
END SUB
' Update a player's position based on the gravity of the suns
SUB UpdatePlayerGravity(Player AS Player)
Dim GravityForce As Single
GravityForce = (Sun1.Mass
And again...
Code: (Select All) more, please (continue listing the rest of the program)
Certainly! Here is the rest of the Spacewar! game in QB64 that allows two players to control their ships with the keyboard, and includes two additional computer-controlled players and two suns:
* Player.Mass) / DistanceToPlayer(Player, Sun1) ^ 2
Player.X = Player.X + GravityForce * (Sun1.X - Player.X) / DistanceToPlayer(Player, Sun1)
Player.Y = Player.Y + GravityForce * (Sun1.Y - Player.Y) / DistanceToPlayer(Player, Sun1)
GravityForce = (Sun2.Mass * Player.Mass) / DistanceToPlayer(Player, Sun2) ^ 2
Player.X = Player.X + GravityForce * (Sun2.X - Player.X) / DistanceToPlayer(Player, Sun2)
Player.Y = Player.Y + GravityForce * (Sun2.Y - Player.Y) / DistanceToPlayer(Player, Sun2)
END SUB
' Update a shot's position based on its speed and angle
SUB UpdateShot(Shot AS Shot)
Shot.X = Shot.X + Shot.Speed * COS(Shot.Angle)
Shot.Y = Shot.Y + Shot.Speed * SIN(Shot.Angle)
END SUB
' Draw a player
SUB DrawPlayer(Player AS Player)
SCREEN(Player.X, Player.Y) = Player.Color
SCREEN(Player.X + 5 * COS(Player.Angle), Player.Y + 5 * SIN(Player.Angle)) = Player.Color
SCREEN(Player.X + 5 * COS(Player.Angle + 1.5), Player.Y + 5 * SIN(Player.Angle + 1.5)) = Player.Color
SCREEN(Player.X + 5 * COS(Player.Angle - 1.5), Player.Y + 5 * SIN(Player.Angle - 1.5)) = Player.Color
If Player.IsThrusting Then
SCREEN(Player.X + 5 * COS(Player.Angle + 1.5), Player.Y + 5 * SIN(Player.Angle + 1.5)) = RGB(255, 0, 0)
SCREEN(Player.X + 5 * COS(Player.Angle - 1.5), Player.Y + 5 * SIN(Player.Angle - 1.5)) = RGB(255, 0, 0)
End If
END SUB
' Draw a shot
SUB DrawShot(Shot AS Shot)
SCREEN(Shot.X, Shot.Y) = Shot.Color
END SUB
' Initialize the game
SCREEN Initialize
SCREEN SetRes 800, 600
SCREEN SetTitle "Spacewar!"
' Set the player properties
Player1.X = 400
Player1.Y = 300
Player1.Angle = 0
Player1.RotationSpeed = 0
Player1.Speed = 0
Player1.IsThrusting = False
Player1.Mass = 1
Player1.Color = RGB(255, 255, 0)
Set Player1.Shots = New Collection
Player2.X = 400
...aaaaand again...!
Code: (Select All) continue listing the rest of the program please
Certainly! Here is the rest of the Spacewar! game in QB64 that allows two players to control their ships with the keyboard, and includes two additional computer-controlled players and two suns:
Player2.Y = 300
Player2.Angle = 0
Player2.RotationSpeed = 0
Player2.Speed = 0
Player2.IsThrusting = False
Player2.Mass = 1
Player2.Color = RGB(0, 255, 255)
Set Player2.Shots = New Collection
CPUPlayer1.X = 100
CPUPlayer1.Y = 100
CPUPlayer1.Angle = 0
CPUPlayer1.RotationSpeed = 0
CPUPlayer1.Speed = 0
CPUPlayer1.IsThrusting = False
CPUPlayer1.Mass = 1
CPUPlayer1.Color = RGB(255, 0, 255)
Set CPUPlayer1.Shots = New Collection
CPUPlayer2.X = 700
CPUPlayer2.Y = 500
CPUPlayer2.Angle = 0
CPUPlayer2.RotationSpeed = 0
CPUPlayer2.Speed = 0
CPUPlayer2.IsThrusting = False
CPUPlayer2.Mass = 1
CPUPlayer2.Color = RGB(0, 255, 0)
Set CPUPlayer2.Shots = New Collection
' Set the sun properties
Sun1.X = 100
Sun1.Y = 500
Sun1.Mass = 100
Sun2.X = 700
Sun2.Y = 100
Sun2.Mass = 100
' Main game loop
DO
' Clear the screen
SCREEN Cls
' Draw the suns
SCREEN(Sun1.X, Sun1.Y) = RGB(255, 255, 0)
SCREEN(Sun2.X, Sun2.Y) = RGB(255, 255, 0)
' Check for player and sun collisions
If PlayerSunCollision(Player1, Sun1) Or PlayerSunCollision(Player1, Sun2) Then
' End the game
EXIT DO
End If
If PlayerSunCollision(Player2, Sun1) Or PlayerSunCollision(Player2, Sun2) Then
' End the game
EXIT DO
End If
If PlayerSunCollision(CPUPlayer1, Sun1) Or PlayerSunCollision(CPUPlayer1, Sun2) Then
' End the game
EXIT DO
End If
If PlayerSunCollision(CPUPlayer2, Sun1) Or PlayerSunCollision(CPUPlayer2, Sun2) Then
' End the game
EXIT DO
End If
' Check for player collisions
If PlayerCollision(Player
Don't stop now! We're so close! (yeah, right)
Code: (Select All) keep listing the rest of the program
Certainly! Here is the rest of the Spacewar! game in QB64 that allows two players to control their ships with the keyboard, and includes two additional computer-controlled players and two suns:
, Player2) Or PlayerCollision(Player1, CPUPlayer1) Or PlayerCollision(Player1, CPUPlayer2) Then
' End the game
EXIT DO
End If
If PlayerCollision(Player2, CPUPlayer1) Or PlayerCollision(Player2, CPUPlayer2) Then
' End the game
EXIT DO
End If
' Check for shot and player collisions
For i = 0 To Player1.Shots.Count - 1
If ShotPlayerCollision(Player1.Shots(i), Player2) Then
Player1.Shots.Remove(i)
End If
If ShotPlayerCollision(Player1.Shots(i), CPUPlayer1) Then
Player1.Shots.Remove(i)
End If
If ShotPlayerCollision(Player1.Shots(i), CPUPlayer2) Then
Player1.Shots.Remove(i)
End If
Next
For i = 0 To Player2.Shots.Count - 1
If ShotPlayerCollision(Player2.Shots(i), Player1) Then
Player2.Shots.Remove(i)
End If
If ShotPlayerCollision(Player2.Shots(i), CPUPlayer1) Then
Player2.Shots.Remove(i)
End If
If ShotPlayerCollision(Player2.Shots(i), CPUPlayer2) Then
Player2.Shots.Remove(i)
End If
Next
For i = 0 To CPUPlayer1.Shots.Count - 1
If ShotPlayerCollision(CPUPlayer1.Shots(i), Player1) Then
CPUPlayer1.
I can't wait to piece this all together, and see what this hunk of burnin' love hath wrought!
Code: (Select All) please keep going and list the rest
Certainly! Here is the rest of the Spacewar! game in QB64 that allows two players to control their ships with the keyboard, and includes two additional computer-controlled players and two suns:
Shots.Remove(i)
End If
If ShotPlayerCollision(CPUPlayer1.Shots(i), Player2) Then
CPUPlayer1.Shots.Remove(i)
End If
If ShotPlayerCollision(CPUPlayer1.Shots(i), CPUPlayer2) Then
CPUPlayer1.Shots.Remove(i)
End If
Next
For i = 0 To CPUPlayer2.Shots.Count - 1
If ShotPlayerCollision(CPUPlayer2.Shots(i), Player1) Then
CPUPlayer2.Shots.Remove(i)
End If
If ShotPlayerCollision(CPUPlayer2.Shots(i), Player2) Then
CPUPlayer2.Shots.Remove(i)
End If
If ShotPlayerCollision(CPUPlayer2.Shots(i), CPUPlayer1) Then
CPUPlayer2.Shots.Remove(i)
End If
Next
' Check for shot and sun collisions
For i = 0 To Player1.Shots.Count - 1
If ShotSunCollision(Player1.Shots(i), Sun1) Or ShotSunCollision(Player1.Shots(i), Sun2) Then
Player1.Shots.Remove(i)
End If
Next
For i = 0 To Player2.Shots.Count - 1
If ShotSunCollision(Player2.Shots(i), Sun1) Or ShotSunCollision(Player2.Shots(i), Sun2) Then
Player2.Shots.Remove(i)
End If
Next
For i = 0 To CPUPlayer1.Shots.Count - 1
If ShotSunCollision(CPUPlayer1.Shots(i), Sun1) Or ShotSunCollision(CPUPlayer1.Shots(i), Sun2) Then
CPUPlayer1.Shots.Remove(i)
End If
Next
For i = 0 To CPUPlayer2.Shots.Count - 1
If ShotSunCollision(CPUPlayer2.Shots(i), Sun1) Or ShotSunCollision(CPUPlayer2.Shots(i), Sun2) Then
CPUPlayer2.Shots.Remove(i)
End If
Next
' Update the player rotations
UpdatePlayerRotation Player1, KEY(37), KEY(39)
UpdatePlayerRotation Player2, KEY(65), KEY(68)
' Update the player thrusts
UpdatePlayerThrust Player1, KEY(38)
Update
I must be a glutton for punishment!
(and you too, gentle reader, if you're still following along!)
Code: (Select All) please list the rest
Certainly! Here is the rest of the Spacewar! game in QB64 that allows two players to control their ships with the keyboard, and includes two additional computer-controlled players and two suns:
PlayerThrust Player2, KEY(87)
' Update the players' positions
UpdatePlayerPosition Player1
UpdatePlayerPosition Player2
UpdateCPUPlayers
' Update the players' positions based on gravity
UpdatePlayerGravity Player1
UpdatePlayerGravity Player2
UpdatePlayerGravity CPUPlayer1
UpdatePlayerGravity CPUPlayer2
' Update the shots' positions
For i = 0 To Player1.Shots.Count - 1
UpdateShot Player1.Shots(i)
Next
For i = 0 To Player2.Shots.Count - 1
UpdateShot Player2.Shots(i)
Next
For i = 0 To CPUPlayer1.Shots.Count - 1
UpdateShot CPUPlayer1.Shots(i)
Next
For i = 0 To CPUPlayer2.Shots.Count - 1
UpdateShot CPUPlayer2.Shots(i)
Next
' Draw the players
DrawPlayer Player1
DrawPlayer Player2
DrawPlayer CPUPlayer1
DrawPlayer CPUPlayer2
' Draw the shots
For i = 0 To Player1.Shots.Count - 1
DrawShot Player1.Shots(i)
Next
For i = 0 To Player2.Shots.Count - 1
DrawShot Player2.Shots(i)
Next
For i = 0 To CPUPlayer1.Shots.Count - 1
DrawShot CPUPlayer1.Shots(i)
Next
For i = 0 To CPUPlayer2.Shots.Count - 1
DrawShot CPUPlayer2.Shots(i)
Next
' Check for player firing
If KEY(13) Then
Dim Shot As Shot
Shot.X = Player1.X + 5 * COS(Player1.Angle)
Shot.Y = Player1.Y + 5 * SIN(Player1.Angle
Will it ever end???
Code: (Select All) please list the rest
Certainly! Here is the rest of the Spacewar! game in QB64 that allows two players to control their ships with the keyboard, and includes two additional computer-controlled players and two suns:
Shot.Angle = Player1.Angle
Shot.Speed = 5
Shot.Color = RGB(255, 255, 255)
Player1.Shots.Add Shot
End If
If KEY(69) Then
Dim Shot As Shot
Shot.X = Player2.X + 5 * COS(Player2.Angle)
Shot.Y = Player2.Y + 5 * SIN(Player2.Angle)
Shot.Angle = Player2.Angle
Shot.Speed = 5
Shot.Color = RGB(255, 255, 255)
Player2.Shots.Add Shot
End If
' Update the screen
SCREEN Update
LOOP
' End the game
SCREEN Close
I hope this helps! Let me know if you have any questions or need further assistance.
ChatGPT Dec 15 Version. Free Research Preview. Our goal is to make AI systems more natural and safe to interact with. Your feedback will help us improve.
You hope this helps!
Oh it helped, all right!
Helped me straight to the looney bin!
Up next, let's try to piece this bad boy together!
|
|
|
| Useful Constants |
|
Posted by: SMcNeill - 12-16-2022, 08:23 PM - Forum: SMcNeill
- Replies (1)
|
 |
Code: (Select All) 'Common CONST which I tend to find very useful to plug into programs
Const True = -1%%
Const False = 0%%
$If WIN Then
Const Slash = "\"
$Else
Const Slash = "/"
$End If
Dim Shared As String MyAppPath, MyAppName, MyAppFullPath, Quote ' These are shared strings, but they need to be gotten at the start of a program.
MyAppPath = _CWD$ ' I'll grab them here and just pretend that they're CONST.
MyAppName = Mid$(Command$(0), _InStrRev(Command$(0), Slash$) + 1) 'Shhh... don't tell anyone. It'll be our little secret!
MyAppFullPath = MyAppPath + Slash + MyAppName
Quote = Chr$(34)
'Variable Type Limits
Const Bit_Min = -1`, Bit_Max = 0`
Const UBit_Min = 0~`, UBit_Max = 1~`
Const Byte_Min = -128%%, Byte_Max = 127%%, Int8_Min = -128%%, Int8_Max = 127%%
Const UByte_Min = 0~%%, UByte_Max = 255~%%, UInt8_Min = 0~%%, UInt_Max = 255~%%
Const Integer_Min = -32768%, Integer_Max = 32767%, Int16_Min = -32768%, Int16_Max = 32767%
Const UInteger_Min = 0~%, UInteger_Max = 65535~%, UInt16_Min = 0~%, UInt16_Max = 65535~%
Const Long_Min = -2147483648&, Long_Max = 2147483647&, Int32_Min = -2147483648&, Int32_Max = 2147483647&
Const ULong_Min = 0~&, ULong_Max = 4294967295~&, UInt32_Min = 0~&, UInt32_Max = 4294967295~&
Const Integer64_Min = -9223372036854775808&&, Integer64_Max = 9223372036854775807&&, Int64_Min = -9223372036854775808&&, Int64_Max = 9223372036854775807&&
Const UInteger64_Min = 0~&&, UInteger64_Max = 18446744073709551615~&&, UInt64_Min = 0~&&, UInt64_Max = 18446744073709551615~&&
Const Single_Min! = -2.802597E-45, Single_Max! = 3.402823E+38
Const Double_Min# = -4.490656458412465E-324, Double_Max = 1.797693134862310E+308
Const Float_Min## = -1.18E-4932, Float_Max## = 1.18E+4932
$If 32BIT Then
Const Offset_Min = -2147483648&, Offset_Max = 2147483647&
Const UOffset_Min = 0~&, UOffset_Max = 4294967295~&
$Else
Const Offset_Min = -9223372036854775808&&, Offset_Max = 9223372036854775807&&
Const UOffset_Min = 0~&&, UOffset_Max = 18446744073709551615~&&
$End If
'Keyhit Values
Const Key_Backspace = 8
Const Key_Tab = 9
Const Key_Enter = 13
Const Key_Shift = 16
Const Key_Control = 17
Const Key_Alt = 18
Const Key_CapsLock = 20
Const Key_ESC = 27
Const Key_Space = 32
Const Key_LeftShift = 100304
Const Key_RightShift = 100303
Const Key_LeftCtrl = 100306
Const Key_RightCtrl = 100305
Const Key_LeftAlt = 100308
Const Key_RightAlt = 100307
Const Key_PageUp = 18688
Const Key_PageDown = 20736
Const Key_LeftArrow = 19200
Const Key_RightArrow = 19712
Const Key_UpArrow = 18432
Const Key_DownArrow = 20480
Const Key_F1 = 15104
Const Key_F2 = 15360
Const Key_F3 = 15616
Const Key_F4 = 15872
Const Key_F5 = 16128
Const Key_F6 = 16384
Const Key_F7 = 16640
Const Key_F8 = 16896
Const Key_F9 = 17152
Const Key_F10 = 17408
Const Key_F11 = 34048
Const Key_F12 = 34304
Const Key_Home = 18176
Const Key_Delete = 21248
Const Key_Insert = 20992
Const Key_Win = 100311
Const Key_Menu = 100319
Const Key_PrintScreen = 900044
Const Key_ScrollLock = 100302
Const Key_Accent = 96
Const Key_Tilde = 126
Const Key_1 = 49
Const Key_2 = 50
Const Key_3 = 51
Const Key_4 = 52
Const Key_5 = 53
Const Key_6 = 54
Const Key_7 = 55
Const Key_8 = 56
Const Key_9 = 57
Const Key_0 = 48
Const Key_Minus = 45, Key_Dash = 45, Key_Subtract = 45
Const Key_Equal = 61
Const Key_Exclaim = 33
Const Key_At = 64
Const Key_Pound = 35
Const Key_Dollar = 36
Const Key_Percent = 37
Const Key_Power = 94, Key_Caret = 94
Const Key_And = 38
Const Key_Star = 42, Key_Multiply = 42
Const Key_LeftParen = 40
Const Key_RightParen = 41
Const Key_Underscore = 95
Const Key_Plus = 43, Key_Add = 43
Const Key_LowerCase = 32 ' Add to key values to get lowercase characters
Const Key_A = 65, Key_A_Low = 97 'for example, 65 is A. 65 + 32 = a (97)
Const Key_B = 66, Key_B_Low = 98 'So it's basically IF Key_B AND Key_LowerCase THEN 'it's a "b"
Const Key_C = 67, Key_C_Low = 99
Const Key_D = 68, Key_D_Low = 10
Const Key_E = 69, Key_E_Low = 101
Const Key_F = 70, Key_F_Low = 102
Const Key_G = 71, Key_G_Low = 103
Const Key_H = 72, Key_H_Low = 104
Const Key_I = 73, Key_I_Low = 105
Const Key_J = 74, Key_J_Low = 106
Const Key_K = 75, Key_K_Low = 107
Const Key_L = 76, Key_L_Low = 108
Const Key_M = 77, Key_M_Low = 109
Const Key_N = 78, Key_N_Low = 110
Const Key_O = 79, Key_O_Low = 111
Const Key_P = 80, Key_P_Low = 112
Const Key_Q = 81, Key_Q_Low = 113
Const Key_R = 82, Key_R_Low = 114
Const Key_S = 83, Key_S_Low = 115
Const Key_T = 84, Key_T_Low = 116
Const Key_U = 85, Key_U_Low = 117
Const Key_V = 86, Key_V_Low = 118
Const Key_W = 87, Key_W_Low = 119
Const Key_X = 88, Key_X_Low = 110
Const Key_Y = 89, Key_Y_Low = 111
Const Key_Z = 90, Key_Z_Low = 112
Const Key_LeftBrace = 91, Key_LeftBracket = 91
Const Key_RightBrace = 93, Key_RightBracket = 93
Const Key_BackSlash = 92
Const Key_LeftCurly = 123
Const Key_RightCurly = 125
Const Key_Pipe = 124
Const Key_Semicolon = 59
Const Key_Colon = 58
Const Key_Apostrophy = 39
Const Key_Quote = 34
Const Key_Comma = 44
Const Key_Period = 46, Key_Dot = 46
Const Key_ForwardSlash = 47, Key_Slash = 47
Const Key_LessThan = 60
Const Key_GreaterThan = 62
Const Key__QuestionMark = 63, Key_Question = 63
'Note that the following keys are listed as 900000+. These are KeyHit codes from my KeyHit library and not _KEYHIT values.
'For _KEYHIT values, drop the 900 in front, and QB64-PE will report the other values on a KEYUP event only.
'So you can read Mute, but it'll *ONLY* read as -173, and that's *only* when you release the key.
'None of these read at all for us on keydown events.
Const Key_Mute = 900173
Const Key_VolUp = 900174
Const Key_VolDown = 900175
Const Key_Stop = 900178
Const Key_Rewind = 900177
Const Key_Forward = 900176
Const Key_Play = 900179
'And for the following, these are also 900000+ KeyHit library codes. These are mouse events that QB64-PE simply fails to recognize
'at all. These neither register with _KEYHIT as a keydown, nor a keyup event. As far as _KEYHIT is concerned, these keys
'simply don't exist!
Const Key_LeftMouse = 900001
Const Key_RightMouse = 900002
Const Key_MiddleMouse = 900004
Const Key_Mouse4 = 900005
Const Key_Mouse5 = 900006
'Inkey$ Codes
Dim Shared As String Inkey_Backspace: Inkey_Backspace = Chr$(8)
Dim Shared As String Inkey_Tab: Inkey_Tab = Chr$(9)
Dim Shared As String Inkey_Enter: Inkey_Enter = Chr$(13)
Dim Shared As String Inkey_ESC: Inkey_ESC = Chr$(27)
Const Inkey_Space = " "
Dim Shared As String Inkey_PageUp: Inkey_PageUp = MKI$(18688)
Dim Shared As String Inkey_PageDown: Inkey_PageDown = MKI$(20736)
Dim Shared As String Inkey_LeftArrow: Inkey_LeftArrow = MKI$(19200)
Dim Shared As String Inkey_RightArrow: Inkey_RightArrow = MKI$(19712)
Dim Shared As String Inkey_UpArrow: Inkey_UpArrow = MKI$(18432)
Dim Shared As String Inkey_DownArrow: Inkey_DownArrow = MKI$(20480)
Dim Shared As String Inkey_F1: Inkey_F1 = MKI$(15104)
Dim Shared As String Inkey_F2: Inkey_F2 = MKI$(15360)
Dim Shared As String Inkey_F3: Inkey_F3 = MKI$(15616)
Dim Shared As String Inkey_F4: Inkey_F4 = MKI$(15872)
Dim Shared As String Inkey_F5: Inkey_F5 = MKI$(16128)
Dim Shared As String Inkey_F6: Inkey_F6 = MKI$(16384)
Dim Shared As String Inkey_F7: Inkey_F7 = MKI$(16640)
Dim Shared As String Inkey_F8: Inkey_F8 = MKI$(16896)
Dim Shared As String Inkey_F9: Inkey_F9 = MKI$(17152)
Dim Shared As String Inkey_F10: Inkey_F10 = MKI$(17408)
Dim Shared As String Inkey_F11: Inkey_F11 = MKI$(34048)
Dim Shared As String Inkey_F12: Inkey_F12 = MKI$(34304)
Dim Shared As String Inkey_Home: Inkey_Home = MKI$(18176)
Dim Shared As String Inkey_Delete: Inkey_Delete = MKI$(21248)
Dim Shared As String Inkey_Insert: Inkey_Insert = MKI$(20992)
Const Inkey_Accent = "`"
Const Inkey_Tilde = "~"
Const Inkey_1 = "1"
Const Inkey_2 = "2"
Const Inkey_3 = "3"
Const Inkey_4 = "4"
Const Inkey_5 = "5"
Const Inkey_6 = "6"
Const Inkey_7 = "7"
Const Inkey_8 = "8"
Const Inkey_9 = "9"
Const Inkey_0 = "0"
Const Inkey_Minus = "-", Inkey_Dash = "-", Inkey_Subtract = "-"
Const Inkey_Equal = "="
Const Inkey_Exclaim = "!"
Const Inkey_At = "@"
Const Inkey_Pound = "#"
Const Inkey_Dollar = "$"
Const Inkey_Percent = "%"
Const Inkey_Power = "^", Inkey_Caret = "^"
Const Inkey_And = "&"
Const Inkey_Star = "*", Inkey_Multiply = "*"
Const Inkey_LeftParen = "("
Const Inkey_RightParen = ")"
Const Inkey_Underscore = "_"
Const Inkey_Plus = "+", Inkey_Add = "+"
Const Inkey_A = "A", Inkey_A_Low = "a" 'for example, 65 is A. 65 + 32 = a (97)
Const Inkey_B = "B", Inkey_B_Low = "b" 'So it's basically IF Inkey_B AND Inkey_LowerCase THEN 'it's a "b"
Const Inkey_C = "C", Inkey_C_Low = "c"
Const Inkey_D = "D", Inkey_D_Low = "d"
Const Inkey_E = "E", Inkey_E_Low = "e"
Const Inkey_F = "F", Inkey_F_Low = "f"
Const Inkey_G = "G", Inkey_G_Low = "g"
Const Inkey_H = "H", Inkey_H_Low = "h"
Const Inkey_I = "I", Inkey_I_Low = "i"
Const Inkey_J = "J", Inkey_J_Low = "j"
Const Inkey_K = "K", Inkey_K_Low = "k"
Const Inkey_L = "L", Inkey_L_Low = "l"
Const Inkey_M = "M", Inkey_M_Low = "m"
Const Inkey_N = "N", Inkey_N_Low = "n"
Const Inkey_O = "O", Inkey_O_Low = "o"
Const Inkey_P = "P", Inkey_P_Low = "p"
Const Inkey_Q = "Q", Inkey_Q_Low = "q"
Const Inkey_R = "R", Inkey_R_Low = "r"
Const Inkey_S = "S", Inkey_S_Low = "s"
Const Inkey_T = "T", Inkey_T_Low = "t"
Const Inkey_U = "U", Inkey_U_Low = "u"
Const Inkey_V = "V", Inkey_V_Low = "v"
Const Inkey_W = "W", Inkey_W_Low = "w"
Const Inkey_X = "X", Inkey_X_Low = "x"
Const Inkey_Y = "Y", Inkey_Y_Low = "y"
Const Inkey_Z = "Z", Inkey_Z_Low = "z"
Const Inkey_LeftBrace = "[", Inkey_LeftBracket = "["
Const Inkey_RightBrace = "]", Inkey_RightBracket = "]"
Const Inkey_BackSlash = "\"
Const Inkey_LeftCurly = "{"
Const Inkey_RightCurly = "}"
Const Inkey_Pipe = "|"
Const Inkey_Semicolon = ";"
Const Inkey_Colon = ":"
Const Inkey_Apostrophy = "'"
Dim Shared As String Inkey_Quote: Inkey_Quote = Chr$(34)
Const Inkey_Comma = ","
Const Inkey_Period = ".", Inkey_Dot = "."
Const Inkey_ForwardSlash = "/", Inkey_Slash = "/"
Const Inkey_LessThan = "<"
Const Inkey_GreaterThan = ">"
Const Inkey_QuestionMark = "?", Inkey_Question = "?"
A list of the various CONST that I find myself endlessly using in my programs. Gathered in one spot like this, they make for an easy $INCLUDE at the top of my code, and then I can make use of the names and values without having to always look up a keycode chart somewhere for my needs.
For example, what's the minimum value you can use for a LONG? Long_Min!
What's the input value of the left arrow key with Inkey$? Inkey_LeftArrow!
What's the keydown value of the left shift key? Key_LeftShift!
Names of things that are much easier to remember than their actual values -- that's all this is. Free to use, abuse, and alter as wanted/needed.
Enjoy, guys. 
|
|
|
|
| DAY 036: _STRCMP |
|
Posted by: Pete - 12-16-2022, 07:09 PM - Forum: Keyword of the Day!
- Replies (3)
|
 |
Ever want to compare strings, without being called a racist? Well now you can with _STRCMP...
SYNTAX compare% = _STRCMP(string1$, string2$)
What does it do? _STRCMP reads each string from left to right, and compares each ASCII character value. At the first instance where one value is not equal to the other, the function exits and returns:
-1 If the string character being compared in the first string is smaller than the string character being compared in the second string.
0 If the strings are equal.
1 If the string character being compared in the first string is larger than the string character being compared in the second string.
Also, remember that: Upper case letters are valued less than lower case letters in the ASCII evaluation. (Wiki).
So here is a quick function using our Keyword of the Day to see how it "functions."
Code: (Select All) DO
LINE INPUT "String 1: "; a$
LINE INPUT "String 2: "; b$: PRINT
IF a$ = "" AND b$ = "" THEN END
PRINT scompare(a$, b$)
PRINT
LOOP
FUNCTION scompare$ (string1$, string2$)
a% = _STRCMP(string1$, string2$)
SELECT CASE a%
CASE -1
scompare$ = "The first string is smaller than the second string."
CASE 0
scompare$ = "The first string is equal to the second string."
CASE 1
scompare$ = "The first string is larger than the second string."
END SELECT
END FUNCTION
Well hold on a minute there, Sparky...
What if I input a$ = 99.9 and b$ = 1024?
Well, _STRCMP would correctly return "The first string is larger than the second string." because with left to right evaluation, "9" of a$ is larger than "1" of b$.
To get a method to tell you if the value of a string representing a numeric value like we use in String Math routines, requires a bit of work...
Code: (Select All) DO
LINE INPUT "Number 1: "; s1$
LINE INPUT "Number 2: "; s2$
IF s1$ = "" OR s2$ = "" THEN EXIT DO
gl% = 0: sm_greater_lesser s1$, s2$, gl%
SELECT CASE gl%
CASE -1: PRINT s1$; " < "; s2$
CASE 0: PRINT s1$; " = "; s2$
CASE 1: PRINT s1$; " > "; s2$
END SELECT
PRINT
LOOP
SUB sm_greater_lesser (stringmatha$, stringmathb$, gl%)
compa$ = stringmatha$: compb$ = stringmathb$ ' So original variables do not get changed.
DO
WHILE -1 ' Falx loop.
IF gl% = 2 THEN EXIT WHILE ' For bypassing sign and decimal adjustments when only positive non-decimal numbers are being evaluated.
' Remove trailing zeros after a decimal point.
IF INSTR(compa$, ".") THEN
DO UNTIL RIGHT$(compa$, 1) <> "0" AND RIGHT$(compa$, 1) <> "." AND RIGHT$(compa$, 1) <> "-"
compa$ = MID$(compa$, 1, LEN(compa$) - 1)
LOOP
END IF
IF INSTR(compb$, ".") THEN
DO UNTIL RIGHT$(compb$, 1) <> "0" AND RIGHT$(compb$, 1) <> "." AND RIGHT$(compb$, 1) <> "-"
compb$ = MID$(compb$, 1, LEN(compb$) - 1)
LOOP
END IF
IF MID$(compa$, 1, 2) = "-0" OR compa$ = "" OR compa$ = "-" THEN compa$ = "0"
IF MID$(compb$, 1, 2) = "-0" OR compb$ = "" OR compb$ = "-" THEN compb$ = "0"
' A - and +
j% = 0: k% = 0
IF LEFT$(compa$, 1) = "-" THEN j% = -1
IF LEFT$(compb$, 1) = "-" THEN k% = -1
IF k% = 0 AND j% THEN gl% = -1: EXIT DO
IF j% = 0 AND k% THEN gl% = 1: EXIT DO
j&& = INSTR(compa$, ".")
k&& = INSTR(compb$, ".")
' A starting decimal and non-decimal.
IF j&& = 0 AND k&& = 1 THEN
IF compa$ = "0" THEN gl% = -1 ELSE gl% = 1
EXIT DO
END IF
IF k&& = 0 AND j&& = 1 THEN
IF compb$ = "0" THEN gl% = 1 ELSE gl% = -1
EXIT DO
END IF
' remove decimals and align.
j2&& = 0: k2&& = 0
IF j&& <> 0 OR k&& <> 0 THEN
IF j&& THEN compa$ = MID$(compa$, 1, INSTR(compa$, ".") - 1) + MID$(compa$, INSTR(compa$, ".") + 1): j2&& = LEN(compa$) - j&& + 1
IF k&& THEN compb$ = MID$(compb$, 1, INSTR(compb$, ".") - 1) + MID$(compb$, INSTR(compb$, ".") + 1): k2&& = LEN(compb$) - k&& + 1
compa$ = compa$ + STRING$(k2&& - j2&&, "0")
compb$ = compb$ + STRING$(j2&& - k2&&, "0")
END IF
EXIT WHILE
WEND
' Remove leading zeros if any.
DO UNTIL LEFT$(compa$, 1) <> "0"
compa$ = MID$(compa$, 2)
LOOP
IF compa$ = "" THEN compa$ = "0"
DO UNTIL LEFT$(compb$, 1) <> "0"
compb$ = MID$(compb$, 2)
LOOP
IF compb$ = "" THEN compb$ = "0"
' Both positive or both negative whole numbers.
SELECT CASE LEN(compa$)
CASE IS < LEN(compb$)
gl% = -1
CASE IS = LEN(compb$)
IF compa$ = compb$ THEN
gl% = 0
ELSEIF compa$ > compb$ THEN gl% = 1
ELSEIF compa$ < compb$ THEN gl% = -1
END IF
CASE IS > LEN(compb$)
gl% = 1
END SELECT
EXIT DO
LOOP
END SUB
So sure, doing a simple numeric comparison like...
Code: (Select All) PRINT 99999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999997 = 99999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999997.1
...works, but below, using a strings to represent these values, the VAL() function converts our string numbers to S.N. with some loss of accuracy along the way.
Code: (Select All) PRINT VAL("99999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999997") > VAL("99999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999999997.1")
So since String Math is designed for enormous numbers, a string comparison function for val() had to be created. If you have an alternative, please post, but otherwise please just keep in mind the difference between _STRCMP, which compares the ASCII character values from left to right, and the function I posted, which compares the numeric value of the strings.
Pete
|
|
|
|
| program generated by chatgpt |
|
Posted by: James D Jarvis - 12-16-2022, 07:06 PM - Forum: General Discussion
- Replies (17)
|
 |
this program was generated by chat gpt. I did have to lightly edit it because it tried to use the symbol "&" in place of the symbol ";" in print commands, otherwise it all came from this prompt:
create qb64pe source code that allows the user to select from a displayed list of 10 entries.
Code: (Select All) ' Define an array to hold the list of entries
Dim entries(10) As String
' Populate the array with sample data
entries(1) = "Apple"
entries(2) = "Banana"
entries(3) = "Cherry"
entries(4) = "Date"
entries(5) = "Eggplant"
entries(6) = "Fig"
entries(7) = "Grape"
entries(8) = "Honeydew"
entries(9) = "Kiwi"
entries(10) = "Lemon"
' Display the list of entries
Print "Please select an entry from the list:"
For i = 1 To 10
Print i; ") "; entries(i)
Next i
' Get the user's selection
Do
Input "Enter your selection: ", selection
If selection < 1 Or selection > 10 Then
Print "Invalid selection. Please try again."
Else
Exit Do
End If
Loop
' Display the selected entry
Print "You selected: "; entries(selection)
|
|
|
|
| _OS$ Very interesting, but... |
|
Posted by: Pete - 12-16-2022, 04:57 PM - Forum: Help Me!
- Replies (4)
|
|
Rowin and Martin's Laugh IN aside,
I don't quite get this about _OS$.
The wiki states _OS$ ireturns the operating system that compiled the program. So If I compile a program in Windows, and a Linux user gets the .exe file, and runs it., all the _OS$ conditional statements can do is to indicate to the Linux user the exe was compiled on a Windows OS.
It seems to me we would be better off having it or something else identify the OS the exe is actually running on, but maybe I'm missing some value here. I haven't used it before.
Pete
|
|
|
|
| Sending Color to Specific Location |
|
Posted by: Dimster - 12-16-2022, 04:03 PM - Forum: Works in Progress
- Replies (7)
|
|
I was just wondering if there is way to change the color of a value which is displaying on a screen. For example, something like this
Screen _NewImage(1900, 900, 32)
$Color:32
A$ = "5"
Color White
_PrintString (100, 100), A$
Color Green
_printstring (100,100), color green
So the value 5 is displaying on the screen in white however, later on in the program I want that value to pop out if certain conditions apply. Present coding requires a complete repeat of the value plus the new color but if I just want to change the color only at that same location doesn't appear color only can be changed? or might there be a way???
|
|
|
|
| Liney Christmas Star |
|
Posted by: James D Jarvis - 12-16-2022, 01:54 PM - Forum: Christmas Code
- No Replies
|
|
one of my facebook groups has gone insane with christmas stars and somebody posted a much simpler version of this that I just had to dress up and add options to.
press any key for a new Christmas star
press c to copy the values to the clipboard, if you see one you want to try to use elsewhere (for windows users, edit it out if you can't use the clipboard command)
press <ESC> to quit
Code: (Select All) ' xmas star
' modified from
' https://www.youtube.com/watch?v=vw3k3xkGtIY
'
' press any key for a new star
' press c to copy values to clipboard
'press ESC to quit
Screen _NewImage(800, 600, 32)
_Title "X-Mas Star"
Randomize Timer
Do
Cls
segments = 8 + 2 * (Int(Rnd * 12))
lineop = Int(Rnd * 14)
xorigin = _Width \ 2
yorigin = _Height \ 2
Color 0: Rem color black
r1 = 70 + Int(Rnd * 150)
r2 = r1 / Int(2 + Rnd * 3)
For counter = 0 To segments
If counter Mod 2 = 0 Then
radius = r1
Else
radius = r2
End If
angle = 360 / segments * counter
angle = angle / 360 * 2 * 3.141592654
x = radius * Sin(angle) + xorigin
y = radius * -Cos(angle) + yorigin
Rem PSet (x, y)
Line (x_hold, y_hold)-(x, y)
Select Case lineop
Case 1
Line (xorigin, yorigin)-(x, y)
Case 2
If counter Mod 2 = 0 Then Line (xorigin, yorigin)-(x, y)
Case 3
If counter Mod 2 <> 0 Then Line (xorigin, yorigin)-(x, y)
Case 4
x2 = 1.2 * radius * Sin(angle) + xorigin
y2 = 1.2 * radius * -Cos(angle) + yorigin
Line (xh2, yh2)-(x2, y2)
xh2 = x2
yh2 = y2
Case 5
x2 = 1.4 * radius * Sin(angle) + xorigin
y2 = 1.4 * radius * -Cos(angle) + yorigin
Line (xh2, yh2)-(x2, y2)
Line (x, y)-(x2, y2)
xh2 = x2
yh2 = y2
Case 6
x2 = 1.2 * radius * Sin(angle) + xorigin
y2 = 1.2 * radius * -Cos(angle) + yorigin
Line (xh2, yh2)-(x2, y2)
xh2 = x2
yh2 = y2
Line (xorigin, yorigin)-(x, y)
Case 7
x2 = 1.2 * radius * Sin(angle) + xorigin
y2 = 1.2 * radius * -Cos(angle) + yorigin
Line (xh2, yh2)-(x2, y2)
xh2 = x2
yh2 = y2
If counter Mod 2 = 0 Then Line (xorigin, yorigin)-(x, y)
Case 8
x2 = 1.2 * radius * Sin(angle) + xorigin
y2 = 1.2 * radius * -Cos(angle) + yorigin
Line (xh2, yh2)-(x2, y2)
xh2 = x2
yh2 = y2
If counter Mod 2 <> 0 Then Line (xorigin, yorigin)-(x, y)
Case 9
x2 = 1.4 * radius * Sin(angle) + xorigin
y2 = 1.4 * radius * -Cos(angle) + yorigin
x3 = 1.2 * radius * Sin(angle) + xorigin
y3 = 1.2 * radius * -Cos(angle) + yorigin
Line (xh2, yh2)-(x2, y2)
Line (xh3, yh3)-(x3, y3)
Line (x3, y3)-(x2, y2)
xh2 = x2
yh2 = y2
xh3 = x3
yh3 = y3
Case 10
x2 = 1.4 * radius * Sin(angle) + xorigin
y2 = 1.4 * radius * -Cos(angle) + yorigin
x3 = 1.2 * radius * Sin(angle) + xorigin
y3 = 1.2 * radius * -Cos(angle) + yorigin
Line (xh2, yh2)-(x2, y2)
Line (xh3, yh3)-(x3, y3)
Line (x3, y3)-(x2, y2)
Line (xorigin, yorigin)-(x, y)
xh2 = x2
yh2 = y2
xh3 = x3
yh3 = y3
Case 11
x2 = 1.4 * radius * Sin(angle) + xorigin
y2 = 1.4 * radius * -Cos(angle) + yorigin
x3 = 1.2 * radius * Sin(angle) + xorigin
y3 = 1.2 * radius * -Cos(angle) + yorigin
Line (xh2, yh2)-(x2, y2)
Line (xh3, yh3)-(x3, y3)
Line (x3, y3)-(x2, y2)
If counter Mod 2 = 0 Then Line (xorigin, yorigin)-(x, y)
xh2 = x2
yh2 = y2
xh3 = x3
yh3 = y3
Case 12
x2 = 1.4 * radius * Sin(angle) + xorigin
y2 = 1.4 * radius * -Cos(angle) + yorigin
x3 = 1.2 * radius * Sin(angle) + xorigin
y3 = 1.2 * radius * -Cos(angle) + yorigin
Line (xh2, yh2)-(x2, y2)
Line (xh3, yh3)-(x3, y3)
Line (x3, y3)-(x2, y2)
If counter Mod 2 <> 0 Then Line (xorigin, yorigin)-(x, y)
xh2 = x2
yh2 = y2
xh3 = x3
yh3 = y3
End Select
Color _RGB32(100 + Rnd * 155, 100 + Rnd * 155, 100 + Rnd * 155)
x_hold = x
y_hold = y
Next counter
Do
_Limit 30
kk$ = InKey$
Loop Until kk$ <> ""
'comment this part out if you aren't running in windows
'--------------------------------------------
If kk$ = "c" Then
cc$ = "lineop " + Str$(lineop) + ", segments " + Str$(segments) + ", radius1 " + Str$(r1) + ", radius2 " + Str$(r2)
_Clipboard$ = cc$
Locate 1, 1: Print "Values copied to clipboard"
Sleep 1
End If
'--------------------------
Loop Until kk$ = Chr$(27)
|
|
|
|
| Screen Saver Function Call |
|
Posted by: eoredson - 12-16-2022, 06:11 AM - Forum: Help Me!
- Replies (10)
|
 |
I have been using this code to call the screen saver and blank the windows screen:
But for some reason it stopped working!?
Does anyone know of a screen saver function call that actually works?
Thanks, Erik.
Code: (Select All) ' declare external libraries.
Declare Dynamic Library "user32"
Function SendMessageA%& (ByVal hWnd%&, Byval Msg~&, Byval wParam~%&, Byval lParam%&)
End Declare
' declare screen saver call constants
Const wm_syscommand = &H112&
Const sc_screensave = &HF140&
Sleep 2
s%& = SendMessageA(&HFFFF&, wm_syscommand, sc_screensave, 0&)
|
|
|
|
| ASCII_xmas trees |
|
Posted by: James D Jarvis - 12-16-2022, 04:08 AM - Forum: Christmas Code
- Replies (4)
|
|
Some randomly decorated ascii xmas trees.
Code: (Select All) 'ascii X_mas trees
_Title "ASCII X_mas Trees"
Randomize Timer
Do
tmid = 40
Color 14, 0
Locate 3, tmid
Print "X"
treetri tmid, 3, 5
treetri tmid, 6, 7
treetri tmid, 11, 8
Color 6, 0
Locate 20, tmid: Print "#"
Locate 21, tmid: Print "#"
Color 15, 0
tmid = 20
Color 14, 0
Locate 6, tmid: Print "x"
treetri tmid, 6, 4
treetri tmid, 8, 6
treetri tmid, 11, 8
Color 6, 0
Locate 20, tmid: Print "#"
Locate 21, tmid: Print "#"
Color 15, 0
tmid = 60
Color 14, 0
Locate 6, tmid: Print "x"
treetri tmid, 6, 4
treetri tmid, 8, 6
treetri tmid, 11, 8
Color 6, 0
Locate 20, tmid: Print "#"
Locate 21, tmid: Print "#"
Color 15, 0
Do
_Limit 30
kk$ = InKey$
Loop Until kk$ <> ""
Loop Until kk$ = Chr$(27)
Sub treetri (tx, ty, th)
For y = 1 To th
For x = tx - y + 1 To tx + y - 1
Color 2, 0
Locate y + ty, x: Print "*"
Select Case Int(Rnd * 12)
Case 1
Color 4, 0
Locate y + ty, x: Print "O"
Case 2
Color 14, 0
Locate y + ty, x: Print "o"
End Select
Next x
Next y
End Sub
|
|
|
|
| BadLimit |
|
Posted by: SMcNeill - 12-16-2022, 03:50 AM - Forum: Works in Progress
- Replies (9)
|
|
Code: (Select All) Type ConfigSettings_Type
Heading As String
Name As String
Value As String
High As String
Low As String
Default As String
End Type
Type Color_Type
Name As String
Value As _Unsigned Long
End Type
ReDim Shared ConfigSettings(0) As ConfigSettings_Type
ReDim Shared Kolor(1000) As Color_Type
count = count + 1: Kolor(count).Name = "AliceBlue": Kolor(count).Value = 4293982463
count = count + 1: Kolor(count).Name = "Almond": Kolor(count).Value = 4293910221
count = count + 1: Kolor(count).Name = "AntiqueBrass": Kolor(count).Value = 4291663221
count = count + 1: Kolor(count).Name = "AntiqueWhite": Kolor(count).Value = 4294634455
count = count + 1: Kolor(count).Name = "Apricot": Kolor(count).Value = 4294826421
count = count + 1: Kolor(count).Name = "Aqua": Kolor(count).Value = 4278255615
count = count + 1: Kolor(count).Name = "Aquamarine": Kolor(count).Value = 4286578644
count = count + 1: Kolor(count).Name = "Asparagus": Kolor(count).Value = 4287080811
count = count + 1: Kolor(count).Name = "AtomicTangerine": Kolor(count).Value = 4294943860
count = count + 1: Kolor(count).Name = "Azure": Kolor(count).Value = 4293984255
count = count + 1: Kolor(count).Name = "BananaMania": Kolor(count).Value = 4294633397
count = count + 1: Kolor(count).Name = "Beaver": Kolor(count).Value = 4288643440
count = count + 1: Kolor(count).Name = "Beige": Kolor(count).Value = 4294309340
count = count + 1: Kolor(count).Name = "Bisque": Kolor(count).Value = 4294960324
count = count + 1: Kolor(count).Name = "Bittersweet": Kolor(count).Value = 4294802542
count = count + 1: Kolor(count).Name = "Black": Kolor(count).Value = 4278190080
count = count + 1: Kolor(count).Name = "BlanchedAlmond": Kolor(count).Value = 4294962125
count = count + 1: Kolor(count).Name = "BlizzardBlue": Kolor(count).Value = 4289521134
count = count + 1: Kolor(count).Name = "Blue": Kolor(count).Value = 4278190335
count = count + 1: Kolor(count).Name = "BlueBell": Kolor(count).Value = 4288848592
count = count + 1: Kolor(count).Name = "BlueGray": Kolor(count).Value = 4284914124
count = count + 1: Kolor(count).Name = "BlueGreen": Kolor(count).Value = 4279081146
count = count + 1: Kolor(count).Name = "BlueViolet": Kolor(count).Value = 4287245282
count = count + 1: Kolor(count).Name = "Blush": Kolor(count).Value = 4292763011
count = count + 1: Kolor(count).Name = "BrickRed": Kolor(count).Value = 4291510612
count = count + 1: Kolor(count).Name = "Brown": Kolor(count).Value = 4289014314
count = count + 1: Kolor(count).Name = "BurlyWood": Kolor(count).Value = 4292786311
count = count + 1: Kolor(count).Name = "BurntOrange": Kolor(count).Value = 4294934345
count = count + 1: Kolor(count).Name = "BurntSienna": Kolor(count).Value = 4293557853
count = count + 1: Kolor(count).Name = "CadetBlue": Kolor(count).Value = 4284456608
count = count + 1: Kolor(count).Name = "Canary": Kolor(count).Value = 4294967193
count = count + 1: Kolor(count).Name = "CaribbeanGreen": Kolor(count).Value = 4280079266
count = count + 1: Kolor(count).Name = "CarnationPink": Kolor(count).Value = 4294945484
count = count + 1: Kolor(count).Name = "Cerise": Kolor(count).Value = 4292691090
count = count + 1: Kolor(count).Name = "Cerulean": Kolor(count).Value = 4280134870
count = count + 1: Kolor(count).Name = "ChartReuse": Kolor(count).Value = 4286578432
count = count + 1: Kolor(count).Name = "Chestnut": Kolor(count).Value = 4290534744
count = count + 1: Kolor(count).Name = "Chocolate": Kolor(count).Value = 4291979550
count = count + 1: Kolor(count).Name = "Copper": Kolor(count).Value = 4292711541
count = count + 1: Kolor(count).Name = "Coral": Kolor(count).Value = 4294934352
count = count + 1: Kolor(count).Name = "Cornflower": Kolor(count).Value = 4288335595
count = count + 1: Kolor(count).Name = "CornflowerBlue": Kolor(count).Value = 4284782061
count = count + 1: Kolor(count).Name = "Cornsilk": Kolor(count).Value = 4294965468
count = count + 1: Kolor(count).Name = "CottonCandy": Kolor(count).Value = 4294950105
count = count + 1: Kolor(count).Name = "CrayolaAquamarine": Kolor(count).Value = 4286110690
count = count + 1: Kolor(count).Name = "CrayolaBlue": Kolor(count).Value = 4280251902
count = count + 1: Kolor(count).Name = "CrayolaBlueViolet": Kolor(count).Value = 4285753021
count = count + 1: Kolor(count).Name = "CrayolaBrown": Kolor(count).Value = 4290013005
count = count + 1: Kolor(count).Name = "CrayolaCadetBlue": Kolor(count).Value = 4289771462
count = count + 1: Kolor(count).Name = "CrayolaForestGreen": Kolor(count).Value = 4285378177
count = count + 1: Kolor(count).Name = "CrayolaGold": Kolor(count).Value = 4293379735
count = count + 1: Kolor(count).Name = "CrayolaGoldenrod": Kolor(count).Value = 4294760821
count = count + 1: Kolor(count).Name = "CrayolaGray": Kolor(count).Value = 4287992204
count = count + 1: Kolor(count).Name = "CrayolaGreen": Kolor(count).Value = 4280069240
count = count + 1: Kolor(count).Name = "CrayolaGreenYellow": Kolor(count).Value = 4293978257
count = count + 1: Kolor(count).Name = "CrayolaIndigo": Kolor(count).Value = 4284315339
count = count + 1: Kolor(count).Name = "CrayolaLavender": Kolor(count).Value = 4294751445
count = count + 1: Kolor(count).Name = "CrayolaMagenta": Kolor(count).Value = 4294337711
count = count + 1: Kolor(count).Name = "CrayolaMaroon": Kolor(count).Value = 4291311706
count = count + 1: Kolor(count).Name = "CrayolaMidnightBlue": Kolor(count).Value = 4279912566
count = count + 1: Kolor(count).Name = "CrayolaOrange": Kolor(count).Value = 4294931768
count = count + 1: Kolor(count).Name = "CrayolaOrangeRed": Kolor(count).Value = 4294912811
count = count + 1: Kolor(count).Name = "CrayolaOrchid": Kolor(count).Value = 4293306583
count = count + 1: Kolor(count).Name = "CrayolaPlum": Kolor(count).Value = 4287513989
count = count + 1: Kolor(count).Name = "CrayolaRed": Kolor(count).Value = 4293795917
count = count + 1: Kolor(count).Name = "CrayolaSalmon": Kolor(count).Value = 4294941610
count = count + 1: Kolor(count).Name = "CrayolaSeaGreen": Kolor(count).Value = 4288668351
count = count + 1: Kolor(count).Name = "CrayolaSilver": Kolor(count).Value = 4291675586
count = count + 1: Kolor(count).Name = "CrayolaSkyBlue": Kolor(count).Value = 4286634731
count = count + 1: Kolor(count).Name = "CrayolaSpringGreen": Kolor(count).Value = 4293716670
count = count + 1: Kolor(count).Name = "CrayolaTann": Kolor(count).Value = 4294616940
count = count + 1: Kolor(count).Name = "CrayolaThistle": Kolor(count).Value = 4293642207
count = count + 1: Kolor(count).Name = "CrayolaViolet": Kolor(count).Value = 4287786670
count = count + 1: Kolor(count).Name = "CrayolaYellow": Kolor(count).Value = 4294764675
count = count + 1: Kolor(count).Name = "CrayolaYellowGreen": Kolor(count).Value = 4291158916
count = count + 1: Kolor(count).Name = "Crimson": Kolor(count).Value = 4292613180
count = count + 1: Kolor(count).Name = "Cyan": Kolor(count).Value = 4278255615
count = count + 1: Kolor(count).Name = "Dandelion": Kolor(count).Value = 4294826861
count = count + 1: Kolor(count).Name = "DarkBlue": Kolor(count).Value = 4278190219
count = count + 1: Kolor(count).Name = "DarkCyan": Kolor(count).Value = 4278225803
count = count + 1: Kolor(count).Name = "DarkGoldenRod": Kolor(count).Value = 4290283019
count = count + 1: Kolor(count).Name = "DarkGray": Kolor(count).Value = 4289309097
count = count + 1: Kolor(count).Name = "DarkGreen": Kolor(count).Value = 4278215680
count = count + 1: Kolor(count).Name = "DarkKhaki": Kolor(count).Value = 4290623339
count = count + 1: Kolor(count).Name = "DarkMagenta": Kolor(count).Value = 4287299723
count = count + 1: Kolor(count).Name = "DarkOliveGreen": Kolor(count).Value = 4283788079
count = count + 1: Kolor(count).Name = "DarkOrange": Kolor(count).Value = 4294937600
count = count + 1: Kolor(count).Name = "DarkOrchid": Kolor(count).Value = 4288230092
count = count + 1: Kolor(count).Name = "DarkRed": Kolor(count).Value = 4287299584
count = count + 1: Kolor(count).Name = "DarkSalmon": Kolor(count).Value = 4293498490
count = count + 1: Kolor(count).Name = "DarkSeaGreen": Kolor(count).Value = 4287609999
count = count + 1: Kolor(count).Name = "DarkSlateBlue": Kolor(count).Value = 4282924427
count = count + 1: Kolor(count).Name = "DarkSlateGray": Kolor(count).Value = 4281290575
count = count + 1: Kolor(count).Name = "DarkTurquoise": Kolor(count).Value = 4278243025
count = count + 1: Kolor(count).Name = "DarkViolet": Kolor(count).Value = 4287889619
count = count + 1: Kolor(count).Name = "DeepPink": Kolor(count).Value = 4294907027
count = count + 1: Kolor(count).Name = "DeepSkyBlue": Kolor(count).Value = 4278239231
count = count + 1: Kolor(count).Name = "Denim": Kolor(count).Value = 4281035972
count = count + 1: Kolor(count).Name = "DesertSand": Kolor(count).Value = 4293905848
count = count + 1: Kolor(count).Name = "DimGray": Kolor(count).Value = 4285098345
count = count + 1: Kolor(count).Name = "DodgerBlue": Kolor(count).Value = 4280193279
count = count + 1: Kolor(count).Name = "Eggplant": Kolor(count).Value = 4285419872
count = count + 1: Kolor(count).Name = "ElectricLime": Kolor(count).Value = 4291755805
count = count + 1: Kolor(count).Name = "Fern": Kolor(count).Value = 4285643896
count = count + 1: Kolor(count).Name = "FireBrick": Kolor(count).Value = 4289864226
count = count + 1: Kolor(count).Name = "Floralwhite": Kolor(count).Value = 4294966000
count = count + 1: Kolor(count).Name = "ForestGreen": Kolor(count).Value = 4280453922
count = count + 1: Kolor(count).Name = "Fuchsia": Kolor(count).Value = 4290995397
count = count + 1: Kolor(count).Name = "FuzzyWuzzy": Kolor(count).Value = 4291585638
count = count + 1: Kolor(count).Name = "Gainsboro": Kolor(count).Value = 4292664540
count = count + 1: Kolor(count).Name = "GhostWhite": Kolor(count).Value = 4294506751
count = count + 1: Kolor(count).Name = "Gold": Kolor(count).Value = 4294956800
count = count + 1: Kolor(count).Name = "GoldenRod": Kolor(count).Value = 4292519200
count = count + 1: Kolor(count).Name = "GrannySmithApple": Kolor(count).Value = 4289258656
count = count + 1: Kolor(count).Name = "Gray": Kolor(count).Value = 4286611584
count = count + 1: Kolor(count).Name = "Green": Kolor(count).Value = 4278222848
count = count + 1: Kolor(count).Name = "GreenBlue": Kolor(count).Value = 4279329972
count = count + 1: Kolor(count).Name = "GreenYellow": Kolor(count).Value = 4289593135
count = count + 1: Kolor(count).Name = "Grey": Kolor(count).Value = 4286611584
count = count + 1: Kolor(count).Name = "HoneyDew": Kolor(count).Value = 4293984240
count = count + 1: Kolor(count).Name = "HotMagenta": Kolor(count).Value = 4294909390
count = count + 1: Kolor(count).Name = "HotPink": Kolor(count).Value = 4294928820
count = count + 1: Kolor(count).Name = "Inchworm": Kolor(count).Value = 4289915997
count = count + 1: Kolor(count).Name = "IndianRed": Kolor(count).Value = 4291648604
count = count + 1: Kolor(count).Name = "Indigo": Kolor(count).Value = 4283105410
count = count + 1: Kolor(count).Name = "Ivory": Kolor(count).Value = 4294967280
count = count + 1: Kolor(count).Name = "JazzberryJam": Kolor(count).Value = 4291442535
count = count + 1: Kolor(count).Name = "JungleGreen": Kolor(count).Value = 4282101903
count = count + 1: Kolor(count).Name = "Khaki": Kolor(count).Value = 4293977740
count = count + 1: Kolor(count).Name = "LaserLemon": Kolor(count).Value = 4294901282
count = count + 1: Kolor(count).Name = "Lavender": Kolor(count).Value = 4293322490
count = count + 1: Kolor(count).Name = "LavenderBlush": Kolor(count).Value = 4294963445
count = count + 1: Kolor(count).Name = "LawnGreen": Kolor(count).Value = 4286381056
count = count + 1: Kolor(count).Name = "LemonChiffon": Kolor(count).Value = 4294965965
count = count + 1: Kolor(count).Name = "LemonYellow": Kolor(count).Value = 4294964303
count = count + 1: Kolor(count).Name = "LightBlue": Kolor(count).Value = 4289583334
count = count + 1: Kolor(count).Name = "LightCoral": Kolor(count).Value = 4293951616
count = count + 1: Kolor(count).Name = "LightCyan": Kolor(count).Value = 4292935679
count = count + 1: Kolor(count).Name = "LightGoldenRodYellow": Kolor(count).Value = 4294638290
count = count + 1: Kolor(count).Name = "LightGray": Kolor(count).Value = 4292072403
count = count + 1: Kolor(count).Name = "LightGreen": Kolor(count).Value = 4287688336
count = count + 1: Kolor(count).Name = "LightPink": Kolor(count).Value = 4294948545
count = count + 1: Kolor(count).Name = "LightSalmon": Kolor(count).Value = 4294942842
count = count + 1: Kolor(count).Name = "LightSeaGreen": Kolor(count).Value = 4280332970
count = count + 1: Kolor(count).Name = "LightSkyBlue": Kolor(count).Value = 4287090426
count = count + 1: Kolor(count).Name = "LightSlateGray": Kolor(count).Value = 4286023833
count = count + 1: Kolor(count).Name = "LightSteelBlue": Kolor(count).Value = 4289774814
count = count + 1: Kolor(count).Name = "LightYellow": Kolor(count).Value = 4294967264
count = count + 1: Kolor(count).Name = "Lime": Kolor(count).Value = 4278255360
count = count + 1: Kolor(count).Name = "LimeGreen": Kolor(count).Value = 4281519410
count = count + 1: Kolor(count).Name = "Linen": Kolor(count).Value = 4294635750
count = count + 1: Kolor(count).Name = "MacaroniAndCheese": Kolor(count).Value = 4294950280
count = count + 1: Kolor(count).Name = "Magenta": Kolor(count).Value = 4294902015
count = count + 1: Kolor(count).Name = "MagicMint": Kolor(count).Value = 4289392849
count = count + 1: Kolor(count).Name = "Mahogany": Kolor(count).Value = 4291643980
count = count + 1: Kolor(count).Name = "Maize": Kolor(count).Value = 4293775772
count = count + 1: Kolor(count).Name = "Manatee": Kolor(count).Value = 4288125610
count = count + 1: Kolor(count).Name = "MangoTango": Kolor(count).Value = 4294935107
count = count + 1: Kolor(count).Name = "Maroon": Kolor(count).Value = 4286578688
count = count + 1: Kolor(count).Name = "Mauvelous": Kolor(count).Value = 4293892266
count = count + 1: Kolor(count).Name = "MediumAquamarine": Kolor(count).Value = 4284927402
count = count + 1: Kolor(count).Name = "MediumBlue": Kolor(count).Value = 4278190285
count = count + 1: Kolor(count).Name = "MediumOrchid": Kolor(count).Value = 4290401747
count = count + 1: Kolor(count).Name = "MediumPurple": Kolor(count).Value = 4287852763
count = count + 1: Kolor(count).Name = "MediumSeaGreen": Kolor(count).Value = 4282168177
count = count + 1: Kolor(count).Name = "MediumSlateBlue": Kolor(count).Value = 4286277870
count = count + 1: Kolor(count).Name = "MediumSpringGreen": Kolor(count).Value = 4278254234
count = count + 1: Kolor(count).Name = "MediumTurquoise": Kolor(count).Value = 4282962380
count = count + 1: Kolor(count).Name = "MediumVioletRed": Kolor(count).Value = 4291237253
count = count + 1: Kolor(count).Name = "Melon": Kolor(count).Value = 4294818996
count = count + 1: Kolor(count).Name = "MidnightBlue": Kolor(count).Value = 4279834992
count = count + 1: Kolor(count).Name = "MintCream": Kolor(count).Value = 4294311930
count = count + 1: Kolor(count).Name = "MistyRose": Kolor(count).Value = 4294960353
count = count + 1: Kolor(count).Name = "Moccasin": Kolor(count).Value = 4294960309
count = count + 1: Kolor(count).Name = "MountainMeadow": Kolor(count).Value = 4281383567
count = count + 1: Kolor(count).Name = "Mulberry": Kolor(count).Value = 4291120012
count = count + 1: Kolor(count).Name = "NavajoWhite": Kolor(count).Value = 4294958765
count = count + 1: Kolor(count).Name = "Navy": Kolor(count).Value = 4278190208
count = count + 1: Kolor(count).Name = "NavyBlue": Kolor(count).Value = 4279858386
count = count + 1: Kolor(count).Name = "NeonCarrot": Kolor(count).Value = 4294943555
count = count + 1: Kolor(count).Name = "OldLace": Kolor(count).Value = 4294833638
count = count + 1: Kolor(count).Name = "Olive": Kolor(count).Value = 4286611456
count = count + 1: Kolor(count).Name = "OliveDrab": Kolor(count).Value = 4285238819
count = count + 1: Kolor(count).Name = "OliveGreen": Kolor(count).Value = 4290426988
count = count + 1: Kolor(count).Name = "Orange": Kolor(count).Value = 4294944000
count = count + 1: Kolor(count).Name = "OrangeRed": Kolor(count).Value = 4294919424
count = count + 1: Kolor(count).Name = "OrangeYellow": Kolor(count).Value = 4294497640
count = count + 1: Kolor(count).Name = "Orchid": Kolor(count).Value = 4292505814
count = count + 1: Kolor(count).Name = "OuterSpace": Kolor(count).Value = 4282468940
count = count + 1: Kolor(count).Name = "OutrageousOrange": Kolor(count).Value = 4294929994
count = count + 1: Kolor(count).Name = "PacificBlue": Kolor(count).Value = 4280068553
count = count + 1: Kolor(count).Name = "PaleGoldenRod": Kolor(count).Value = 4293847210
count = count + 1: Kolor(count).Name = "PaleGreen": Kolor(count).Value = 4288215960
count = count + 1: Kolor(count).Name = "PaleTurquoise": Kolor(count).Value = 4289720046
count = count + 1: Kolor(count).Name = "PaleVioletRed": Kolor(count).Value = 4292571283
count = count + 1: Kolor(count).Name = "PapayaWhip": Kolor(count).Value = 4294963157
count = count + 1: Kolor(count).Name = "Peach": Kolor(count).Value = 4294954923
count = count + 1: Kolor(count).Name = "PeachPuff": Kolor(count).Value = 4294957753
count = count + 1: Kolor(count).Name = "Periwinkle": Kolor(count).Value = 4291154150
count = count + 1: Kolor(count).Name = "Peru": Kolor(count).Value = 4291659071
count = count + 1: Kolor(count).Name = "PiggyPink": Kolor(count).Value = 4294827494
count = count + 1: Kolor(count).Name = "PineGreen": Kolor(count).Value = 4279599224
count = count + 1: Kolor(count).Name = "Pink": Kolor(count).Value = 4294951115
count = count + 1: Kolor(count).Name = "PinkFlamingo": Kolor(count).Value = 4294735101
count = count + 1: Kolor(count).Name = "PinkSherbet": Kolor(count).Value = 4294414247
count = count + 1: Kolor(count).Name = "Plum": Kolor(count).Value = 4292714717
count = count + 1: Kolor(count).Name = "PowderBlue": Kolor(count).Value = 4289781990
count = count + 1: Kolor(count).Name = "Purple": Kolor(count).Value = 4286578816
count = count + 1: Kolor(count).Name = "PurpleHeart": Kolor(count).Value = 4285809352
count = count + 1: Kolor(count).Name = "PurpleMountainsMajesty": Kolor(count).Value = 4288512442
count = count + 1: Kolor(count).Name = "PurplePizzazz": Kolor(count).Value = 4294856410
count = count + 1: Kolor(count).Name = "RadicalRed": Kolor(count).Value = 4294920556
count = count + 1: Kolor(count).Name = "RawSienna": Kolor(count).Value = 4292250201
count = count + 1: Kolor(count).Name = "RawUmber": Kolor(count).Value = 4285614883
count = count + 1: Kolor(count).Name = "RazzleDazzleRose": Kolor(count).Value = 4294920400
count = count + 1: Kolor(count).Name = "Razzmatazz": Kolor(count).Value = 4293076331
count = count + 1: Kolor(count).Name = "Red": Kolor(count).Value = 4294901760
count = count + 1: Kolor(count).Name = "RedOrange": Kolor(count).Value = 4294923081
count = count + 1: Kolor(count).Name = "RedViolet": Kolor(count).Value = 4290790543
count = count + 1: Kolor(count).Name = "RobinsEggBlue": Kolor(count).Value = 4280274635
count = count + 1: Kolor(count).Name = "RosyBrown": Kolor(count).Value = 4290547599
count = count + 1: Kolor(count).Name = "RoyalBlue": Kolor(count).Value = 4282477025
count = count + 1: Kolor(count).Name = "RoyalPurple": Kolor(count).Value = 4286075305
count = count + 1: Kolor(count).Name = "SaddleBrown": Kolor(count).Value = 4287317267
count = count + 1: Kolor(count).Name = "Salmon": Kolor(count).Value = 4294606962
count = count + 1: Kolor(count).Name = "SandyBrown": Kolor(count).Value = 4294222944
count = count + 1: Kolor(count).Name = "Scarlet": Kolor(count).Value = 4294715463
count = count + 1: Kolor(count).Name = "ScreaminGreen": Kolor(count).Value = 4285988730
count = count + 1: Kolor(count).Name = "SeaGreen": Kolor(count).Value = 4281240407
count = count + 1: Kolor(count).Name = "SeaShell": Kolor(count).Value = 4294964718
count = count + 1: Kolor(count).Name = "Sepia": Kolor(count).Value = 4289030479
count = count + 1: Kolor(count).Name = "Shadow": Kolor(count).Value = 4287265117
count = count + 1: Kolor(count).Name = "Shamrock": Kolor(count).Value = 4282764962
count = count + 1: Kolor(count).Name = "ShockingPink": Kolor(count).Value = 4294672125
count = count + 1: Kolor(count).Name = "Sienna": Kolor(count).Value = 4288696877
count = count + 1: Kolor(count).Name = "Silver": Kolor(count).Value = 4290822336
count = count + 1: Kolor(count).Name = "SkyBlue": Kolor(count).Value = 4287090411
count = count + 1: Kolor(count).Name = "SlateBlue": Kolor(count).Value = 4285160141
count = count + 1: Kolor(count).Name = "SlateGray": Kolor(count).Value = 4285563024
count = count + 1: Kolor(count).Name = "Snow": Kolor(count).Value = 4294966010
count = count + 1: Kolor(count).Name = "SpringGreen": Kolor(count).Value = 4278255487
count = count + 1: Kolor(count).Name = "SteelBlue": Kolor(count).Value = 4282811060
count = count + 1: Kolor(count).Name = "Sunglow": Kolor(count).Value = 4294954824
count = count + 1: Kolor(count).Name = "SunsetOrange": Kolor(count).Value = 4294794835
count = count + 1: Kolor(count).Name = "Tann": Kolor(count).Value = 4291998860
count = count + 1: Kolor(count).Name = "Teal": Kolor(count).Value = 4278222976
count = count + 1: Kolor(count).Name = "TealBlue": Kolor(count).Value = 4279805877
count = count + 1: Kolor(count).Name = "Thistle": Kolor(count).Value = 4292394968
count = count + 1: Kolor(count).Name = "TickleMePink": Kolor(count).Value = 4294740396
count = count + 1: Kolor(count).Name = "Timberwolf": Kolor(count).Value = 4292597714
count = count + 1: Kolor(count).Name = "Tomato": Kolor(count).Value = 4294927175
count = count + 1: Kolor(count).Name = "TropicalRainForest": Kolor(count).Value = 4279730285
count = count + 1: Kolor(count).Name = "Tumbleweed": Kolor(count).Value = 4292782728
count = count + 1: Kolor(count).Name = "Turquoise": Kolor(count).Value = 4282441936
count = count + 1: Kolor(count).Name = "TurquoiseBlue": Kolor(count).Value = 4286045671
count = count + 1: Kolor(count).Name = "UnmellowYellow": Kolor(count).Value = 4294967142
count = count + 1: Kolor(count).Name = "Violet": Kolor(count).Value = 4293821166
count = count + 1: Kolor(count).Name = "VioletBlue": Kolor(count).Value = 4281486002
count = count + 1: Kolor(count).Name = "VioletRed": Kolor(count).Value = 4294398868
count = count + 1: Kolor(count).Name = "VividTangerine": Kolor(count).Value = 4294942857
count = count + 1: Kolor(count).Name = "VividViolet": Kolor(count).Value = 4287582365
count = count + 1: Kolor(count).Name = "Wheat": Kolor(count).Value = 4294303411
count = count + 1: Kolor(count).Name = "White": Kolor(count).Value = 4294967295
count = count + 1: Kolor(count).Name = "Whitesmoke": Kolor(count).Value = 4294309365
count = count + 1: Kolor(count).Name = "WildBlueYonder": Kolor(count).Value = 4288851408
count = count + 1: Kolor(count).Name = "WildStrawberry": Kolor(count).Value = 4294919076
count = count + 1: Kolor(count).Name = "WildWatermelon": Kolor(count).Value = 4294732933
count = count + 1: Kolor(count).Name = "Wisteria": Kolor(count).Value = 4291667166
count = count + 1: Kolor(count).Name = "Yellow": Kolor(count).Value = 4294967040
count = count + 1: Kolor(count).Name = "YellowGreen": Kolor(count).Value = 4288335154
count = count + 1: Kolor(count).Name = "YellowOrange": Kolor(count).Value = 4294946370
ReDim _Preserve Kolor(count) As Color_Type
$Color:32
Print BadLimit("unsigned integer", "-1", "2"), "unsigned integer from -1 to 2"
Print BadLimit("integer", "-1", "1"), "integer from -1 to 1"
c1$ = "black": c2$ = "white"
Print BadLimit("color", c1$, c2$), "color from "; c1$; " to "; c2$
Print BadLimit("color", c2$, c1$), "color from "; c2$; " to "; c1$
c1$ = "&HFF000000": c2$ = "&HFFFFFFFF"
Print BadLimit("color", c1$, c2$), "color from "; c1$; " to "; c2$
c1$ = "_RGB32(0,0,0)": c2$ = "_RGB32(255,255,255)"
Print BadLimit("color", c1$, c2$), "color from "; c1$; " to "; c2$
Sub DeclareConfigSetting (heading$, name$, type$, low$, high$, default$, value$)
Dim As String h, tn, tt, tl, th, td, tv
'Preserve user values by transfering them to temp copies of their original selfs
h = _Trim$(heading$): tn = _Trim$(name$): tt = _Trim$(UCase$(type$))
tl = _Trim$(low$): th = _Trim$(high$): td = _Trim$(default$): tv = _Trim$(value$)
'prevent duplicate braces from being around our heading
h = RemoveCharacters(h, "[", 1)
h = RemoveCharacters(h, "]", 2)
If h = "" Then h = "[Unsorted Settings]" Else h = "[" + h + "]"
'check for blank variable names. If that's what we have, then toss an error and quit.
If tn = "" Then
_MessageBox "Terminal Error", "Configuration setting [NULL] can not declared. All settings must have a valid name. Terminating the program until the issue is resolved.", "error"
System
End If
'Check to see if the variable name has been declared already. If so, then toss an error and quit.
'If you want to change config type or default values and such, then call EditConfigSetting instead.
u = UBound(ConfigSettings)
For i = 1 To u
If tn = ConfigSettings(i).Name Then
_MessageBox "Terminal Error", "Configuration setting [" + name$ + "] has already been declared. Can not declare the same setting twice. Terminating the program until the issue is resolved.", "error"
System
End If
Next
'Check for invalid limits for the variable type we declared
InValidateLimits = BadLimit(tt, tl, th)
Select Case InvalidLimits
Case 1 'tl is not a number
message$ = "Configuration setting has an invalid low limit set. [" + tl + "] is not a number. Terminating the program until the issue is resolved."
Case 2 'th is not a number
message$ = "Configuration setting has an invalid high limit set. [" + th + "] is not a number. Terminating the program until the issue is resolved."
Case 3 'tl is less than the min possible with the declared type
message$ = "Configuration setting has an invalid low limit set [" + tl + "]. Terminating the program until the issue is resolved."
Case 4 'th is greater than the max possible with the declared type
message$ = "Configuration setting has an invalid high limit set [" + th + "]. Terminating the program until the issue is resolved."
Case 5 'tl is greater than th
message$ = "Configuration setting has a low limit set [" + tl + "] which is greater than the high limit set [" + th + "]. Terminating the program until the issue is resolved."
End Select
If InvalidLimits Then
message$ = message$ + ">> [" + heading$ + "] [" + name$ + "] [" + type$ + "]"
_MessageBox "Terminal Error!", message$, "error"
System
End If
End Sub
Function RemoveCharacters$ (passed_from_what As String, what_character As String, from_which_side As Integer)
'from_which_side: 1 = left, 2 = right, 3 = left and right, 0 = whole string
Dim from_what As String
from_what = passed_from_what
If from_which_side = 0 Then 'strip from the whole string
Do
p = InStr(from_what, what_character)
If p Then from_what = Left$(from_what, p - 1) + Mid$(from_what, p + 1)
Loop Until p = 0
End If
If from_which_side And 1 Then 'strip from the left
Do Until Left$(from_what, 1) <> what_character
from_what = Mid$(from_what, 2)
Loop
End If
If from_which_side And 2 Then 'strip from the right
Do Until Right$(from_what, 1) <> what_character
from_what = Left$(from_what, Len(from_what) - 1)
Loop
End If
RemoveCharacters = from_what
End Function
Function BadLimit (type$, low$, high$)
'Error Report Values
'1 'tl is not a number
'2 'th is not a number
'3 'tl is invalid limit with the declared type (too low or too high, such as -1 for an unsigned integer)
'4 'th is invalid limit with the declared type
'5 'low is larger than high. (a range from 10 to 1, for example)
'Try and sort out type, and overall type limits.
Dim As String tt, tl, th 'temp type, temp low, temp high
Dim As _Integer64 ll1, hli, tlTemp, thTemp 'low limit integer, high limit integer, (temp low temp , temp high temp <-- these last 2 are for color names and such)
Dim As _Float llf, hlf 'low limit float, high limit float
tt = UCase$(_Trim$(type$)): tl = low$: th = high$
Select Case tt
Case "BIT", "_BIT", "_UNSIGNED _BIT", "UNSIGNED BIT", "BOOLEAN", "BOOL", "TRUEFALSE"
type$ = "BOOLEAN"
tl = "": th = ""
Case "BYTE", "_BYTE", "INT8"
type$ = "BYTE"
If tl = "" Then tl = "-128"
If th = "" Then th = "127"
lli = -128: hli = 127
GoSub checkintegers
Case "UNSIGNED BYTE", "_UNSIGNED _BYTE", "UINT8"
type$ = "UNSIGNED BYTE"
If tl = "" Then tl = "0"
If th = "" Then th = "255"
lli = -0: hli = 255
GoSub checkintegers
Case "INTEGER", "INT16"
type$ = "INTEGER"
If tl = "" Then tl = "-32768"
If th = "" Then th = "32767"
lli = -32768: hli = 32767
GoSub checkintegers
Case "UNSIGNED INTEGER", "_UNSIGNED INTEGER", "UINT16"
type$ = "UNSIGNED INTEGER"
If tl = "" Then tl = "0"
If th = "" Then th = "65535"
lli = 0: hli = 65535
GoSub checkintegers
Case "LONG", "INT32"
type$ = "LONG"
If tl = "" Then tl = "-2147483648"
If th = "" Then th = "2147483647"
lli = -2147483648: hli = 2147483647
GoSub checkintegers
Case "UNSIGNED LONG", "_UNSIGNED LONG", "UINT32"
type$ = "UNSIGNED LONG"
If tl = "" Then tl = "0"
If th = "" Then th = "4294967295"
lli = 0: hli = 4294967295
GoSub checkintegers
Case "COLOR", "RGB", "RGB32", "_RGB", "_RGB32"
type$ = "COLOR"
If tl = "" Then tl = "0"
If th = "" Then th = "4294967295"
tlTemp = ColorValue(tl): thTemp = ColorValue(th)
If tlTemp = -1 Then InvalidLimits = 1
If thTemp = -1 Then InvalidLimits = 2
n1$ = tl: n2$ = th
If InvalidLimits = 0 Then
tl = _Trim$(Str$(tlTemp)): th = _Trim$(Str$(thTemp))
lli = 0: hli = 4294967295
GoSub checkintegers
End If
tl = n1$: th = n2$
Case "INTEGER64", "_INTEGER64", "INT64", "OFFSET", "_OFFSET"
type$ = "INTEGER64"
If tl = "" Then tl = "-9223372036854775808"
If th = "" Then th = "-9223372036854775807"
lli = -9223372036854775808&&: hli = -9223372036854775807&&
GoSub checkintegers
Case "UNSIGNED INTEGER64", "_UNSIGNED _INTEGER64", "UINT64", "_UNSIGNED _OFFSET", "UNSIGNED OFFSET"
type$ = "INTEGER64"
If tl = "" Then tl = "0"
If th = "" Then th = "18446744073709551615"
If IsNum(tl) = 0 Then InvalidLimits = 1
If IsNum(th) = 0 Then InvalidLimits = 2
If Val(tl) < 0 Then InvalidLimits = 3
If Val(th + "~&&") > 18446744073709551615~&& Then InvalidLimits = 4
Case "SINGLE"
type$ = "SINGLE"
If tl = "" Then tl = "-2.802597E-45"
If th = "" Then th = "3.402823E+38"
llf = -2.802597E-45: hlf = 3.402823E+38
GoSub checkfloats
Case "DOUBLE"
type$ = "DOUBLE"
If tl = "" Then tl = "-4.490656458412465E-324"
If th = "" Then th = "1.797693134862310E+308"
llf = -4.490656458412465E-324: hlf = 1.797693134862310E+308
GoSub checkfloats
Case "FLOAT", "_FLOAT"
type$ = "FLOAT"
If tl = "" Then tl = "-1.18E-4932"
If th = "" Then th = "1.18E+4932"
llf = -1.18E-4932: hlf = 1.18E+4932
GoSub checkfloats
Case "STRING", "$"
type$ = "STRING"
Case "QSTRING", "Q$"
type$ = "QSTRING"
Case Else 'unspecified or unrecognized type
'we don't change anything, and trust the end-user knows what they're doing and setting
InvalidLimits = 5
tt = type$: tl = low$: th = high$
End Select
BadLimit = InvalidLimits
type$ = tt: low$ = tl: high$ = th
Exit Function 'We're finished and our gosubs go below
checkintegers:
If IsNum(tl) = 0 Then InvalidLimits = 1
If IsNum(th) = 0 Then InvalidLimits = 2
If Val(tl) < lli Or Val(tl) > hli Then InvalidLimits = 3
If Val(th) < lli Or Val(th) > hli Then InvalidLimits = 4
If Val(tl) > Val(th) Then InvalidLimits = 5
Return
checkfloats:
If IsNum(tl) = 0 Then InvalidLimits = 1
If IsNum(th) = 0 Then InvalidLimits = 2
If Val(tl) < llf Or Val(tl) > hlf Then InvalidLimits = 3
If Val(th) < llf Or Val(th) > hlf Then InvalidLimits = 4
If Val(tl) > Val(th) Then InvalidLimits = 5
Return
End Function
Function IsNum%% (PassedText As String)
text$ = PassedText
special$ = UCase$(Left$(text$, 2))
Select Case special$
Case "&H", "&B", "&O"
'check for symbols on right side of value
r3$ = Right$(text$, 3)
Select Case r3$
Case "~&&", "~%%", "~%&" 'unsigned int64, unsigned byte, unsigned offset
text$ = Left$(text$, Len(text$) - 3)
Case Else
r2$ = Right$(text$, 2)
Select Case r2$
Case "~&", "##", "%&", "%%", "~%", "&&" 'unsigned long, float, offset, byte, unsigned integer, int64
text$ = Left$(text$, Len(text$) - 2)
Case Else
r$ = Right$(text$, 1)
Select Case r$
Case "&", "#", "%", "!" 'long, double, integer, single
text$ = Left$(text$, Len(text$) - 1)
End Select
End Select
End Select
check$ = "0123456789ABCDEF"
If special$ = "&O" Then check$ = "01234567"
If special$ = "&B" Then check$ = "01"
temp$ = Mid$(UCase$(text$), 2)
For i = 1 To Len(temp$)
If InStr(check$, Mid$(temp$, i, 1)) = 0 Then Exit For
Next
If i <= Len(temp$) Then IsNum = -1
Case Else
If _Trim$(Str$(Val(text$))) = text$ Then IsNum = -1
End Select
End Function
Function ColorValue&& (text$)
ReDim values(1000) As String
ColorValue = -1 'This is to report a failed attempt to get a valid color.
' All valid colors will be greater than -1, so be certain the return variable is an _INTEGER64 type
' so that this -1 value doesn't overflow and become bright white (most likely), or some other color
If IsNum(text$) Then 'our color is either in plain number form (COLOR 15, for example), or hex form (&HFFFFFFFF, for example)
temp&& = Val(text$)
If temp&& >= 0 Then
ColorValue = temp&&
Else
If temp&& >= -2147483648 Then 'it's probably a color, but in LONG (signed) format. Let's convert it automagically and roll with it.
temp~& = temp&&
ColorValue = temp~&
End If
End If
Else
temp$ = _Trim$(UCase$(text$))
If Left$(temp$, 7) = "_RGBA32" Or Left$(temp$, 6) = "RGBA32" Then 'It's in RGBA32 format
If ParseValues(text$, values()) <> 4 Then ColorValue = -1: Exit Function
r% = Val(values(1))
g% = Val(values(2))
b% = Val(values(3))
a% = Val(values(4))
ColorValue = _RGBA32(r%, g%, b%, a%)
ElseIf Left$(temp$, 5) = "_RGBA" Or Left$(temp$, 4) = "RGBA" Then 'It's in RGBA format
p = ParseValues(text$, values())
If p < 4 Or p > 5 Then ColorValue = -1: Exit Function
r% = Val(values(1))
g% = Val(values(2))
b% = Val(values(3))
a% = Val(values(4))
If p = 5 Then
d% = Val(values(5)) 'the destination of the screen whose palette we're matching against
ColorValue = _RGBA(r%, g%, b%, a%, d%)
Else
ColorValue = _RGBA(r%, g%, b%, a%) 'note that this value will change depending upon the screen that it's called from
'RGBA tries to match the called value to the closest possible color match that the existing palette has.
End If
ElseIf Left$(temp$, 6) = "_RGB32" Or Left$(temp$, 5) = "RGB32" Then 'It's in RGB32 format
p = ParseValues(text$, values())
Select Case p
Case 4 '_RGB32(num, num2, num3, num4) <-- this is RGBA format
r% = Val(values(1))
g% = Val(values(2))
b% = Val(values(3))
a% = Val(values(4))
ColorValue = _RGBA32(r%, g%, b%, a%)
Case 3 ' _RGB32(num, num2, num3) <-- this is RGB format
r% = Val(values(1))
g% = Val(values(2))
b% = Val(values(3))
ColorValue = _RGB32(r%, g%, b%)
Case 2 ' _RGB32(num, num2) <-- Grayscale with alpha
r% = Val(values(1))
g% = Val(values(2))
ColorValue = _RGB32(r%, g%)
Case 1 ' _RGB32(num) <-- Grayscale alone
r% = Val(values(1))
ColorValue = _RGB32(r%)
Case Else
ColorValue = -1: Exit Function '<-- can not return a valid color value
End Select
ElseIf Left$(temp$, 4) = "_RGB" Or Left$(temp$, 3) = "RGB" Then 'It's in RGB format
p = ParseValues(text$, values())
If p < 3 Or p > 4 Then ColorValue = -1: Exit Function
r% = Val(values(1))
g% = Val(values(2))
b% = Val(values(3))
If p = 4 Then
d% = Val(values(4)) 'the destination of the screen whose palette we're matching against
ColorValue = _RGB(r%, g%, b%, d%)
Else
ColorValue = _RGB(r%, g%, b%) 'note that this value will change depending upon the screen that it's called from
'RGBA tries to match the called value to the closest possible color match that the existing palette has.
End If
Else 'check to see if it's a color name value
For i = 1 To UBound(Kolor)
If UCase$(temp$) = UCase$(Kolor(i).Name) Then
text$ = Kolor(i).Name
ColorValue = Kolor(i).Value
Exit Function
End If
Next
End If
End If
End Function
Function ParseValues (text$, values() As String)
ReDim values(1000) As String
temp$ = text$ 'preserve without changing our text
lp = InStr(temp$, "("): temp$ = Mid$(temp$, lp + 1) 'strip off any left sided parenthesis, such as _RGB32(
rp = _InStrRev(temp$, ")"): If rp Then temp$ = Left$(temp$, rp - 1) 'strip off the right sided parenthesis )
Do
p = InStr(temp$, ",")
If p Then
eval$ = Left$(temp$, p - 1)
If IsNum(eval$) = 0 Then ParseValues = -1: Exit Function
count = count + 1
If count > UBound(values) Then ReDim _Preserve values(UBound(values) + 1000) As String
values(count) = eval$
temp$ = Mid$(temp$, p + 1)
Else
eval$ = temp$
If IsNum(eval$) = 0 Then ParseValues = -1: Exit Function
count = count + 1
If count > UBound(values) Then ReDim _Preserve values(UBound(values) + 1) As String
values(count) = eval$
temp$ = ""
End If
Loop Until temp$ = ""
ReDim _Preserve values(count) As String
ParseValues = count
End Function
Much like my little routine to get color values from strings the other day, this is also part of an enhanced config system that I'm working up for a long running personal project of mine. What we have here, that I'm highlighting, is the BadLimit routine which is an essential part of the overall roadmap to what I'm doing. 
BadLimit is a rather complex little piece of code, that simply lets us pass it a variable type and then two values which we want to set to become valid limits for that variable type, and then it checks to see if those two limits are valid or not for that type.
For example, pass it: "Integer", "-1", "10", and it'll pass back a 0 for you. There's nothing bad about a limit from -1 to 10 for an integer.
Pass it, "Unsigned Integer", "-1", "10", and it'll pass back a 3 for you. Error code 3 says you have an invalid low limit. 0 is as low as an unsigned integer can go, so you can't set a limit of -1 for one!
The end goal, is to eventually cobble all the pieces together, so that I can validate and read and write such entries as the following in my config file:
BackGround AS Color FROM Black TO White Default Black = Red
XPos AS INTEGER FROM -32000 TO 32000 DEFAULT 0 = 150
And so on...
(And the above isn't as confusing as it first might seem. For example, the first entry would be for the BackGround color which has to be in a range from full alpha Black to full alpha White, with the default color being Black, but which is current set to being Red.)
I don't know if anyone else would ever need a limit checker, but if someone does, there's one here now that anyone can feel free to use if desired.
|
|
|
|
|
