| Welcome, Guest |
You have to register before you can post on our site.
|
| Latest Threads |
Who wants to PLAY?
Forum: QBJS, BAM, and Other BASICs
Last Post: dbox
49 minutes ago
» Replies: 0
» Views: 5
|
Fun with Ray Casting
Forum: a740g
Last Post: MasterGy
5 hours ago
» Replies: 9
» Views: 163
|
QBJS - ANSI Draw
Forum: QBJS, BAM, and Other BASICs
Last Post: dbox
7 hours ago
» Replies: 3
» Views: 87
|
Cautionary tale of open, ...
Forum: General Discussion
Last Post: doppler
Today, 10:23 AM
» Replies: 3
» Views: 91
|
Extended KotD #23 and #24...
Forum: Keyword of the Day!
Last Post: SMcNeill
Today, 09:51 AM
» Replies: 0
» Views: 35
|
Big problem for me.
Forum: General Discussion
Last Post: JRace
Today, 05:11 AM
» Replies: 11
» Views: 188
|
Virtual Arrays
Forum: Site Suggestions
Last Post: hsiangch_ong
Today, 12:35 AM
» Replies: 8
» Views: 298
|
QBJS v0.9.0 - Release
Forum: QBJS, BAM, and Other BASICs
Last Post: hsiangch_ong
Today, 12:25 AM
» Replies: 17
» Views: 315
|
Very basic key mapping de...
Forum: SMcNeill
Last Post: SMcNeill
Yesterday, 11:18 PM
» Replies: 0
» Views: 35
|
1990's 3D Doom-Like Walls...
Forum: Programs
Last Post: a740g
Yesterday, 06:12 PM
» Replies: 10
» Views: 332
|
|
|
| Haunted House Text Adventure Game |
|
Posted by: Donald Foster - 10-30-2022, 10:42 PM - Forum: Donald Foster
- Replies (15)
|
 |
![[Image: Haunted_House_1981_Tandy_0000.jp2&id=Hau...2&rotate=0]](https://ia600405.us.archive.org/BookReader/BookReaderImages.php?zip=/14/items/Haunted_House_1981_Tandy/Haunted_House_1981_Tandy_jp2.zip&file=Haunted_House_1981_Tandy_jp2/Haunted_House_1981_Tandy_0000.jp2&id=Haunted_House_1981_Tandy&scale=2&rotate=0)
Hello All,
This is my remake of the TRS-80 text adventure game. I posted this game on GB64.org site a while back, but I don't know if any of my games got ported here. I did some touchups to the game since then and will continue making updates. I'm posting it here for the Halloween theme.
The game mostly uses two word commands like "GET KEY" or "KILL GHOST". Use N (north), S (south), E (east) and W (west) to maneuver through the house. INVENT will bring up the list of items you are carrying.
If at any point in the game you die, you will need to restart the game.
Donald
Code: (Select All) _TITLE "TRS-80 MODEL I & III - HAUNTED HOUSE - TEXT ADVENTURE GAME IN QB64"
PAPER = 0: KEYY = 0: KNIFE = 0: ROPE = 0: ARMOUR = 0: CABINET = 0: SCROLL = 0: SWORD = 0: SIGN = 0
GHOST1 = 1: GHOST2 = 1: GHOST3 = 1: GHOST4 = 1: GHOST5 = 0: GHOST6 = 0: GHOST7 = 0: GHOST8 = 0: GHOST11 = 1: GHOST12 = 1: SWORD = 0: SIGN = 0
COLOR 15, 0
PRINT
PRINT "HAUNTED HOUSE is a very simple game. There are no treasures to"
PRINT "find. There are no scores to keep. There is no time limit. You only have"
PRINT "one task - GET OUT OF THE HOUSE ALIVE!!"
PRESSAKEY: A$ = INKEY$: IF A$ = "" GOTO PRESSAKEY
CLS
PRINT
PRINT "Haunted House"
PRINT
PRINT "Generations have passed since the McDaniel family mysteriously"
PRINT "disappeared. It is said that a stranger came to visit on that cold,"
PRINT "Autumn day many years ago, but no one knows for sure."
PRINT
PRINT "Their house has been vacant for decades now. It's two story image is"
PRINT "forlorn and looming, visible only from the narrow, winding road that"
PRINT "distorted by vegetation from the surrounding forest. The"
PRINT "stone wall that encompasses the house is discolor and broken from"
PRINT "years of neglect, it's iron gate rusty and worn by angry seasons. The"
PRINT "windows are boaded - the house is quiet and contented, not"
PRINT "accustomed to visitors. The wind is restless today, blowing fallen"
PRINT "leaves in all directions. As you walk towards the entrance of the house,"
PRINT "the wind grows distant and weak. Suddenly, the calm and silence is"
PRINT "broken by sounds from within the house!"
PRINT
PRINT "Do you have the courage to enter?"
GETYINPUT: A$ = UCASE$(INKEY$): IF A$ <> "Y" GOTO GETYINPUT
CLS: COLOR 2, 0
MESSAGE$ = "HAUNTED HOUSE!!": GOSUB MESSAGE
PRESSANYKEY: A$ = INKEY$: IF A$ = "" THEN GOTO PRESSANYKEY
OUTSIDEOFHOUSE: ' OUTSIDE OF HOUSE
MESSAGE$ = "YOU ARE AT THE OUTSIDE OF THE HOUSE.^THERE IS A CRUMPLED PIECE OF PAPER ON THE GROUND.^THE FRONT DOOR IS CLOSED.": GOSUB MESSAGE
INPUT0: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "PLUGH" OR INPUTT$ = "SAY PLUGH" THEN MESSAGE$ = "YOU MATERIALIZE INSIDE THE DOOR.": GOSUB MESSAGE: GOTO FOYER
IF INPUTT$ = "GET PAPER" THEN PAPER = 1: MESSAGE$ = "OK": GOSUB MESSAGE: GOTO INPUT0
IF INPUTT$ = "READ PAPER" AND PAPER = 1 THEN MESSAGE$ = "IT SAYS, %MAGIC WORD - PLUGH.%": GOSUB MESSAGE: GOTO INPUT0
IF INPUTT$ = "READ PAPER" AND PAPER = 0 THEN MESSAGE$ = "YOU AREN'T CARRYING IT.": GOSUB MESSAGE: GOTO INPUT0
IF INPUTT$ = "OPEN DOOR" THEN MESSAGE$ = "DOOR CAN'T BE OPENED.": GOSUB MESSAGE: GOTO INPUT0
IF INPUTT$ = "DOOR" OR INPUTT$ = "PAPER" OR INPUTT$ = "EXAMINE PAPER" THEN MESSAGE$ = "WHAT SHOULD I DO WITH IT?": GOSUB MESSAGE: GOTO INPUT0
IF INPUTT$ = "LOOK" OR INPUTT$ = "LOOK PAPER" OR INPUTT$ = "N" OR INPUTT$ = "S" OR INPUTT$ = "E" OR INPUTT$ = "W" THEN GOTO OUTSIDEOFHOUSE
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT0
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT0
FOYER: ' FOYER
MESSAGE$ = "YOU ARE AT THE FOYER.": GOSUB MESSAGE
INPUT1: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "PLUGH" OR INPUTT$ = "SAY PLUGH" THEN MESSAGE$ = "SORRY, ONLY ONE PLUGH PER CUSTOMER.": GOSUB MESSAGE: GOTO FOYER
IF INPUTT$ = "DROP PAPER" THEN PAPER = 0: MESSAGE$ = "OK": GOSUB MESSAGE: GOTO FOYER
IF INPUTT$ = "E" THEN GOTO LIVING_ROOM
IF INPUTT$ = "S" THEN GOTO DEN
IF INPUTT$ = "W" THEN GOTO EAST_END_HALL
IF INPUTT$ = "DOOR" OR INPUTT$ = "PAPER" THEN MESSAGE$ = "WHAT SHOULD I DO WITH IT?": GOSUB MESSAGE: GOTO INPUT1
IF INPUTT$ = "LOOK" OR INPUTT$ = "N" THEN GOTO FOYER
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT1
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT1
LIVING_ROOM: ' LIVING ROOM
MESSAGE$ = "YOU ARE AT THE LIVING ROOM.": GOSUB MESSAGE
IF KNIFE = 0 THEN MESSAGE$ = "A KNIFE IS LEVITATING IN THE MIDDLE OF THE ROOM.": GOSUB MESSAGE
IF SCROLL = 0 THEN MESSAGE$ = "THERE IS A MYSTERIOUS SCROLL ON THE GROUND.": GOSUB MESSAGE
INPUT2: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "PLUGH" OR INPUTT$ = "SAY PLUGH" THEN MESSAGE$ = "SORRY, ONLY ONE PLUGH PER CUSTOMER.": GOSUB MESSAGE: GOTO LIVING_ROOM
IF INPUTT$ = "E" THEN GOTO DINING_ROOM
IF INPUTT$ = "W" THEN GOTO FOYER
IF INPUTT$ = "GET SCROLL" THEN SCROLL = 1: MESSAGE$ = "OK": GOSUB MESSAGE: GOTO INPUT2
IF INPUTT$ = "READ SCROLL" AND SCROLL = 0 THEN MESSAGE$ = "YOU AREN'T CARRYING IT.": GOSUB MESSAGE: GOTO INPUT2
IF INPUTT$ = "READ SCROLL" AND SCROLL = 1 THEN MESSAGE$ = "IT SAYS, %THERE IS ESCAPE FROM THE SECOND FLOOR!%": GOSUB MESSAGE: GOTO INPUT2
IF INPUTT$ = "GET KNIFE" AND PAPER = 0 THEN MESSAGE$ = "THE KNIFE FLOATS OUT OF YOUR REACH.": GOSUB MESSAGE: GOTO INPUT2
IF INPUTT$ = "GET KNIFE" AND PAPER = 1 THEN KNIFE = 1: MESSAGE$ = "OK": GOSUB MESSAGE: GOTO INPUT2
IF INPUTT$ = "N" OR INPUTT$ = "S" THEN MESSAGE$ = "SUDDENLY THE KNIFE WHOOSHES DOWN AND SLITS YOUR THROAT! YOU ARE DEAD.": GOSUB MESSAGE: END
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT2
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT2
DINING_ROOM: ' DINING ROOM
MESSAGE$ = "YOU ARE AT THE DINING ROOM.": GOSUB MESSAGE
INPUT3: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "PLUGH" OR INPUTT$ = "SAY PLUGH" THEN MESSAGE$ = "SORRY, ONLY ONE PLUGH PER CUSTOMER.": GOSUB MESSAGE: GOTO DINING_ROOM
IF INPUTT$ = "S" THEN GOTO KITCHEN
IF INPUTT$ = "W" THEN GOTO LIVING_ROOM
IF INPUTT$ = "LOOK" OR INPUTT$ = "N" OR INPUTT$ = "E" THEN GOTO DINING_ROOM
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT3
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT3
KITCHEN: ' KITCHEN
MESSAGE$ = "YOU ARE AT THE KITCHEN.": GOSUB MESSAGE
IF BUCKET = 0 THEN MESSAGE$ = "A BUCKET OF WATER IS ON THE FLOOR.": GOSUB MESSAGE
INPUT4: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "PLUGH" OR INPUTT$ = "SAY PLUGH" THEN MESSAGE$ = "SORRY, ONLY ONE PLUGH PER CUSTOMER.": GOSUB MESSAGE: GOTO KITCHEN
IF INPUTT$ = "N" THEN GOTO DINING_ROOM
IF INPUTT$ = "W" THEN GOTO DEN
IF INPUTT$ = "S" AND KNIFE = 1 THEN MESSAGE$ = "A SUIT OF ARMOUR HERE FLEES WHEN IT SPOTS YOUR KNIFE.": GOSUB MESSAGE: GOTO BREAKFAST_ROOM
IF INPUTT$ = "S" AND KNIFE = 0 THEN MESSAGE$ = "YOU ARE IN THE BREAKFAST ROOM.^AN ANIMATED ARMOUR SUIT THROWS YOU OUT!": GOSUB MESSAGE: GOTO KITCHEN
IF INPUTT$ = "GET BUCKET" THEN BUCKET = 1: MESSAGE$ = "OK": GOSUB MESSAGE: GOTO INPUT4
IF INPUTT$ = "POUR WATER" OR INPUTT$ = "POUR BUCKET" THEN MESSAGE$ = "THE GROUND IS WET. THE BUCKET MAGICALLY REFILLS.": GOSUB MESSAGE: GOTO INPUT4
IF INPUTT$ = "DRINK WATER" AND BUCKET = 0 THEN MESSAGE$ = "YOU AREN'T CARRYING IT.": GOSUB MESSAGE: GOTO INPUT4
IF INPUTT$ = "DRINK WATER" AND BUCKET = 1 THEN MESSAGE$ = "YOU FEEL SICK. IN FACT, YOU JUST DIED! IT WAS POSION.": GOSUB MESSAGE: END
IF INPUTT$ = "LOOK" OR INPUTT$ = "E" THEN GOTO KITCHEN
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT4
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT4
BREAKFAST_ROOM: ' BREAKFAST ROOM
MESSAGE$ = "YOU ARE AT THE BREAKFAST ROOM.": GOSUB MESSAGE
INPUT5: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "PLUGH" OR INPUTT$ = "SAY PLUGH" THEN MESSAGE$ = "SORRY, ONLY ONE PLUGH PER CUSTOMER.": GOSUB MESSAGE: GOTO BREAKFAST_ROOM
IF INPUTT$ = "N" THEN GOTO KITCHEN
IF INPUTT$ = "E" THEN GOTO SERVANTS_QUARTERS1
IF INPUTT$ = "LOOK" OR INPUTT$ = "S" OR INPUTT$ = "W" THEN GOTO BREAKFAST_ROOM
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT5
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT5
SERVANTS_QUARTERS1: ' SERVANTS QUARTERS
MESSAGE$ = "YOU ARE AT THE SERVANTS QUARTERS.^THERE IS A CABINET ON ONE WALL.": GOSUB MESSAGE
INPUT6: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "PLUGH" OR INPUTT$ = "SAY PLUGH" THEN MESSAGE$ = "SORRY, ONLY ONE PLUGH PER CUSTOMER.": GOSUB MESSAGE: GOTO SERVANTS_QUARTERS1
IF INPUTT$ = "N" THEN GOTO SERVANTS_QUARTERS2
IF INPUTT$ = "W" THEN GOTO BREAKFAST_ROOM
IF INPUTT$ = "OPEN CABINET" THEN MESSAGE$ = "IT'S EMPTY.": GOSUB MESSAGE: GOTO INPUT6
IF INPUTT$ = "GET CABINET" THEN MESSAGE$ = "DON'T BE RIDICULOUS!": GOSUB MESSAGE: GOTO INPUT6
IF INPUTT$ = "LOOK" OR INPUTT$ = "S" OR INPUTT$ = "E" THEN GOTO SERVANTS_QUARTERS1
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT6
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT6
SERVANTS_QUARTERS2: ' SERVANTS QUARTERS
MESSAGE$ = "YOU ARE AT THE SERVANTS QUARTERS.^THERE IS A CABINET ON ONE WALL.": GOSUB MESSAGE
INPUT7: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "PLUGH" OR INPUTT$ = "SAY PLUGH" THEN MESSAGE$ = "SORRY, ONLY ONE PLUGH PER CUSTOMER.": GOSUB MESSAGE: GOTO SERVANTS_QUARTERS2
IF INPUTT$ = "S" THEN GOTO SERVANTS_QUARTERS1
IF INPUTT$ = "OPEN CABINET" THEN MESSAGE$ = "THERE IS A KEY IN IT.": GOSUB MESSAGE: GOTO INPUT7
IF INPUTT$ = "GET KEY" THEN KEYY = 1: MESSAGE$ = "OK": GOSUB MESSAGE: GOTO INPUT7
IF INPUTT$ = "LOOK" OR INPUTT$ = "N" OR INPUTT$ = "E" OR INPUTT$ = "W" THEN GOTO SERVANTS_QUARTERS2
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT7
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT7
DEN: ' DEN
MESSAGE$ = "YOU ARE AT THE DEN.": GOSUB MESSAGE
INPUT8: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "PLUGH" OR INPUTT$ = "SAY PLUGH" THEN MESSAGE$ = "SORRY, ONLY ONE PLUGH PER CUSTOMER.": GOSUB MESSAGE: GOTO DEN
IF INPUTT$ = "N" THEN GOTO FOYER
IF INPUTT$ = "E" THEN GOTO KITCHEN
IF INPUTT$ = "LOOK" OR INPUTT$ = "S" OR INPUTT$ = "W" THEN GOTO DEN
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT8
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT8
EAST_END_HALL: ' EAST END OF THE HALL
MESSAGE$ = "YOU ARE AT THE EAST END OF THE HALL.": GOSUB MESSAGE
INPUT9: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "PLUGH" OR INPUTT$ = "SAY PLUGH" THEN MESSAGE$ = "SORRY, ONLY ONE PLUGH PER CUSTOMER.": GOSUB MESSAGE: GOTO EAST_END_HALL
IF INPUTT$ = "N" THEN GOTO GREEN_BEDROOM
IF INPUTT$ = "E" THEN GOTO FOYER
IF INPUTT$ = "W" THEN GOTO WEST_END_HALL
IF INPUTT$ = "LOOK" OR INPUTT$ = "S" THEN GOTO EAST_END_HALL
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT9
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT9
WEST_END_HALL: ' WEST END OF THE HALL
MESSAGE$ = "YOU ARE AT THE WEST END OF THE HALL.^A LOCKED DOOR BARS THE WAY SOUTH.": GOSUB MESSAGE
INPUT10: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "PLUGH" OR INPUTT$ = "SAY PLUGH" THEN MESSAGE$ = "SORRY, ONLY ONE PLUGH PER CUSTOMER.": GOSUB MESSAGE: GOTO WEST_END_HALL
IF INPUTT$ = "N" THEN GOTO BLUE_BEDROOM
IF INPUTT$ = "E" THEN GOTO EAST_END_HALL
IF (INPUTT$ = "S" OR INPUTT$ = "OPEN DOOR") AND KEYY = 1 THEN GOTO MASTER_BEDROOM
IF (INPUTT$ = "S" OR INPUTT$ = "OPEN DOOR") AND KEYY = 0 THEN MESSAGE$ = "YOU'LL NEED A KEY TO GET THROUGH THAT DOOR.": GOSUB MESSAGE: GOTO INPUT10
IF INPUTT$ = "LOOK" OR INPUTT$ = "W" THEN GOTO WEST_END_HALL
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT10
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT10
GREEN_BEDROOM: ' GREEN BEDROOM
MESSAGE$ = "YOU ARE AT THE GREEN BEDROOM. THERE'S A PANEL ON THE WEST WALL.": GOSUB MESSAGE
INPUT11: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "PLUGH" OR INPUTT$ = "SAY PLUGH" THEN MESSAGE$ = "SORRY, ONLY ONE PLUGH PER CUSTOMER.": GOSUB MESSAGE: GOTO GREEN_BEDROOM
IF INPUTT$ = "S" THEN GOTO EAST_END_HALL
IF INPUTT$ = "PANEL" OR INPUTT$ = "OPEN PANEL" OR INPUTT$ = "GO PANEL" THEN GOTO SECRET_PASSAGE
IF INPUTT$ = "LOOK" OR INPUTT$ = "N" OR INPUTT$ = "E" OR INPUTT$ = "W" THEN GOTO GREEN_BEDROOM
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT11
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT11
SECRET_PASSAGE: ' SECRET PASSAGE
MESSAGE$ = "YOU ARE AT THE SECRET PASSAGE.": GOSUB MESSAGE
IF ROPE = 0 THEN MESSAGE$ = "A ROPE IS NEARBY.": GOSUB MESSAGE
INPUT12: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "PLUGH" OR INPUTT$ = "SAY PLUGH" THEN MESSAGE$ = "SORRY, ONLY ONE PLUGH PER CUSTOMER.": GOSUB MESSAGE: GOTO SECRET_PASSAGE
IF INPUTT$ = "E" THEN GOTO GREEN_BEDROOM
IF INPUTT$ = "W" THEN GOTO BLUE_BEDROOM
IF INPUTT$ = "GET ROPE" THEN ROPE = 1: MESSAGE$ = "OK": GOSUB MESSAGE: GOTO INPUT12
IF INPUTT$ = "LOOK" OR INPUTT$ = "N" OR INPUTT$ = "S" THEN GOTO SECRET_PASSAGE
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT12
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT12
BLUE_BEDROOM: ' BLUE BEDROOM
MESSAGE$ = "YOU ARE AT THE BLUE BEDROOM.^THERE'S A PANEL ON THE WEST WALL.": GOSUB MESSAGE
INPUT13: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "PLUGH" OR INPUTT$ = "SAY PLUGH" THEN MESSAGE$ = "SORRY, ONLY ONE PLUGH PER CUSTOMER.": GOSUB MESSAGE: GOTO BLUE_BEDROOM
IF INPUTT$ = "S" THEN GOTO WEST_END_HALL
IF INPUTT$ = "PANEL" OR INPUTT$ = "OPEN PANEL" OR INPUTT$ = "GO PANEL" THEN GOTO SECRET_PASSAGE
IF INPUTT$ = "LOOK" OR INPUTT$ = "N" OR INPUTT$ = "E" OR INPUTT$ = "W" THEN GOTO BLUE_BEDROOM
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT13
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT13
MASTER_BEDROOM: ' MASTER BEDROOM
MESSAGE$ = "YOU ARE IN THE MASTER BEDROOM.^A WALL OF RAGING FIRE BLOCKS THE WAY EAST.": GOSUB MESSAGE
INPUT14: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "PLUGH" OR INPUTT$ = "SAY PLUGH" THEN MESSAGE$ = "SORRY, ONLY ONE PLUGH PER CUSTOMER.": GOSUB MESSAGE: GOTO MASTER_BEDROOM
IF INPUTT$ = "N" THEN GOTO GREEN_BEDROOM
IF INPUTT$ = "E" THEN MESSAGE$ = "ARE YOU JUST GOING TO WALK RIGHT THROUGH THAT RANGING FIRE?": GOSUB MESSAGE: GOTO INPUT14
IF INPUTT$ = "YES" THEN MESSAGE$ = "OK": GOSUB MESSAGE: GOTO LIBRARY
IF INPUTT$ = "NO" THEN MESSAGE$ = "A WISE DECISION.": GOSUB MESSAGE: GOTO INPUT14
IF INPUTT$ = "LOOK" OR INPUTT$ = "W" OR INPUTT$ = "S" THEN GOTO MASTER_BEDROOM
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT14
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT14
LIBRARY: ' LIBRARY
MESSAGE$ = "YOU ARE AT THE LIBRARY. THERE IS A HOLE IN THE CEILING.": GOSUB MESSAGE
INPUT15: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "PLUGH" OR INPUTT$ = "SAY PLUGH" THEN MESSAGE$ = "SORRY, ONLY ONE PLUGH PER CUSTOMER.": GOSUB MESSAGE: GOTO LIBRARY
IF INPUTT$ = "W" THEN GOTO BLUE_BEDROOM
IF INPUTT$ = "DROP ROPE" THEN ROPE = 0: ROPECEILING = 1: MESSAGE$ = "INSTANTLY THE ROPE UNWINDS AND LEVITATES TO THE HOLE IN THE CEILING!": GOSUB MESSAGE: GOTO INPUT15
IF (INPUTT$ = "CLIMB ROPE" OR INPUTT$ = "JUMP ROPE") AND ROPECEILING = 1 THEN MESSAGE$ = "YOU DROP EVERYTHING YOU HAD TO CLIMB THE ROPE. YOU REACH THE SECOND FLOOR.": GOSUB MESSAGE: PAPER = 0: KEYY = 0: KNIFE = 0: ROPE = 0: ARMOUR = 0: CABINET = 0: SCROLL = 0: GOTO DIMLY_ROOM_SWORD
IF INPUTT$ = "LOOK" OR INPUTT$ = "N" OR INPUTT$ = "E" OR INPUTT$ = "S" THEN GOTO LIBRARY
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT15
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT15
DIMLY_ROOM_SWORD: ' DIMLY LIT ROOM WITH SWORD
MESSAGE$ = "YOU ARE IN A DIMLY LIT ROOM. THERE IS A HOLE IN THE FLOOR.": GOSUB MESSAGE
IF SWORD = 0 THEN MESSAGE$ = "THERE IS A MAGIC SWORD ON THE FLOOR.": GOSUB MESSAGE
INPUT16: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "PLUGH" OR INPUTT$ = "SAY PLUGH" THEN MESSAGE$ = "SORRY, ONLY ONE PLUGH PER CUSTOMER.": GOSUB MESSAGE: GOTO DIMLY_ROOM_SWORD
IF INPUTT$ = "E" THEN GOTO DIMLY_ROOM_GHOST1
IF INPUTT$ = "W" THEN GOTO DIMLY_ROOM_GHOST3
IF INPUTT$ = "S" THEN GOTO DIMLY_ROOM_GHOST2
IF INPUTT$ = "GET SWORD" THEN SWORD = 1: MESSAGE$ = "OK": GOSUB MESSAGE: GOTO INPUT16
IF INPUTT$ = "READ SWORD" THEN MESSAGE$ = "AN INCRIPTION READS, %GHOST KILLER.%": GOSUB MESSAGE: GOTO INPUT16
IF INPUTT$ = "DROP SWORD" AND SWORD = 1 THEN SWORD = 0: MESSAGE$ = "OK": GOSUB MESSAGE: GOTO INPUT16
IF INPUTT$ = "DROP SWORD" AND SWORD = 0 THEN MESSAGE$ = "YOU'RE NOT CARRYING IT.": GOSUB MESSAGE: GOTO INPUT16
IF INPUTT$ = "CLIMB ROPE" THEN MESSAGE$ = "YOU FALL THROUGH THE HOLE AND BREAK YOUR NECK! YOU ARE DEAD.": GOSUB MESSAGE: END
IF INPUTT$ = "LOOK" OR INPUTT$ = "N" THEN GOTO DIMLY_ROOM_SWORD
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT16
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT16
DIMLY_ROOM_GHOST1: ' DIMLY LIT ROOM WITH GHOST
MESSAGE$ = "YOU ARE IN A DIMLY LIT ROOM.": GOSUB MESSAGE
IF GHOST1 = 1 THEN MESSAGE$ = "THERE IS A GHOST HERE.": GOSUB MESSAGE
IF GHOST5 = 1 THEN MESSAGE$ = "THE BODY OF A DEAD GHOST IS ON THE FLOOR.": GOSUB MESSAGE
INPUT17: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "KILL GHOST" AND GHOST1 = 1 AND SWORD = 1 THEN GHOST1 = 0: GHOST5 = 1: MESSAGE$ = "YOUR MAGIC SWORD ENABLES YOU TO KILL THE GHOST!": GOSUB MESSAGE: GOTO INPUT17
IF INPUTT$ = "KILL GHOST" AND GHOST1 = 1 AND SWORD = 0 THEN MESSAGE$ = "YOU CAN'T KILL A GHOST WITH YOUR BARE HANDS.": GOSUB MESSAGE: GOTO INPUT17
IF INPUTT$ = "KILL GHOST" AND GHOST5 = 1 THEN MESSAGE$ = "THE POOR THING'S ALREADY DEAD.": GOSUB MESSAGE: GOTO INPUT17
IF INPUTT$ = "KILL SWORD" THEN MESSAGE$ = "OUCH! YOU HURT YOUR HAND.": GOSUB MESSAGE: GOTO INPUT17
IF INPUTT$ = "DROP SWORD" AND SWORD = 1 THEN SWORD = 0: MESSAGE$ = "OK": GOSUB MESSAGE: GOTO INPUT17
IF INPUTT$ = "DROP SWORD" AND SWORD = 0 THEN MESSAGE$ = "YOU'RE NOT CARRYING IT.": GOSUB MESSAGE: GOTO INPUT17
IF INPUTT$ = "W" THEN GOTO DIMLY_ROOM_SWORD
IF (INPUTT$ = "N" OR INPUTT$ = "E" OR INPUTT$ = "S") AND GHOST5 = 1 THEN GOTO DIMLY_ROOM_GHOST1
IF (INPUTT$ = "N" OR INPUTT$ = "E" OR INPUTT$ = "S") AND GHOST1 = 1 THEN MESSAGE$ = "THE GHOST WILL NOT LET YOU PASS!": GOSUB MESSAGE: GOTO INPUT17
IF INPUTT$ = "LOOK" THEN GOTO DIMLY_ROOM_GHOST1
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT17
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT17
DIMLY_ROOM_GHOST2: ' DIMLY LIT ROOM WITH GHOST
MESSAGE$ = "YOU ARE IN A DIMLY LIT ROOM.": GOSUB MESSAGE
IF GHOST2 = 1 THEN MESSAGE$ = "THERE IS A GHOST HERE.": GOSUB MESSAGE
IF GHOST6 = 1 THEN MESSAGE$ = "THE BODY OF A DEAD GHOST IS ON THE FLOOR.": GOSUB MESSAGE
INPUT18: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "KILL GHOST" AND GHOST2 = 1 AND SWORD = 1 THEN GHOST2 = 0: GHOST6 = 1: MESSAGE$ = "YOUR MAGIC SWORD ENABLES YOU TO KILL THE GHOST!": GOSUB MESSAGE: GOTO INPUT18
IF INPUTT$ = "KILL GHOST" AND GHOST2 = 1 AND SWORD = 0 THEN MESSAGE$ = "YOU CAN'T KILL A GHOST WITH YOUR BARE HANDS.": GOSUB MESSAGE: GOTO INPUT18
IF INPUTT$ = "KILL GHOST" AND GHOST6 = 1 THEN MESSAGE$ = "THE POOR THING'S ALREADY DEAD.": GOSUB MESSAGE: GOTO INPUT18
IF INPUTT$ = "KILL SWORD" THEN MESSAGE$ = "OUCH! YOU HURT YOUR HAND.": GOSUB MESSAGE: GOTO INPUT18
IF INPUTT$ = "DROP SWORD" AND SWORD = 1 THEN SWORD = 0: MESSAGE$ = "OK": GOSUB MESSAGE: GOTO INPUT18
IF INPUTT$ = "DROP SWORD" AND SWORD = 0 THEN MESSAGE$ = "YOU'RE NOT CARRYING IT.": GOSUB MESSAGE: GOTO INPUT18
IF INPUTT$ = "N" THEN GOTO DIMLY_ROOM_SWORD
IF (INPUTT$ = "W" OR INPUTT$ = "E" OR INPUTT$ = "S") AND GHOST6 = 1 THEN GOTO DIMLY_ROOM_GHOST2
IF (INPUTT$ = "W" OR INPUTT$ = "E" OR INPUTT$ = "S") AND GHOST2 = 1 THEN MESSAGE$ = "THE GHOST WILL NOT LET YOU PASS!": GOSUB MESSAGE: GOTO INPUT18
IF INPUTT$ = "LOOK" THEN GOTO DIMLY_ROOM_GHOST2
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT18
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT18
DIMLY_ROOM_GHOST3: ' DIMLY LIT ROOM WITH GHOST
MESSAGE$ = "YOU ARE IN A DIMLY LIT ROOM.": GOSUB MESSAGE
IF GHOST3 = 1 THEN MESSAGE$ = "THERE IS A GHOST HERE.": GOSUB MESSAGE
IF GHOST7 = 1 THEN MESSAGE$ = "THE BODY OF A DEAD GHOST IS ON THE FLOOR.": GOSUB MESSAGE
INPUT19: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "KILL GHOST" AND GHOST3 = 1 AND SWORD = 1 THEN GHOST3 = 0: GHOST7 = 1: MESSAGE$ = "YOUR MAGIC SWORD ENABLES YOU TO KILL THE GHOST!": GOSUB MESSAGE: GOTO INPUT19
IF INPUTT$ = "KILL GHOST" AND GHOST3 = 1 AND SWORD = 0 THEN MESSAGE$ = "YOU CAN'T KILL A GHOST WITH YOUR BARE HANDS.": GOSUB MESSAGE: GOTO INPUT19
IF INPUTT$ = "KILL GHOST" AND GHOST7 = 1 THEN MESSAGE$ = "THE POOR THING'S ALREADY DEAD.": GOSUB MESSAGE: GOTO INPUT19
IF INPUTT$ = "KILL SWORD" THEN MESSAGE$ = "OUCH! YOU HURT YOUR HAND.": GOSUB MESSAGE: GOTO INPUT19
IF INPUTT$ = "DROP SWORD" AND SWORD = 1 THEN SWORD = 0: MESSAGE$ = "OK": GOSUB MESSAGE: GOTO INPUT19
IF INPUTT$ = "DROP SWORD" AND SWORD = 0 THEN MESSAGE$ = "YOU'RE NOT CARRYING IT.": GOSUB MESSAGE: GOTO INPUT19
IF INPUTT$ = "E" THEN GOTO DIMLY_ROOM_SWORD
IF INPUTT$ = "W" AND GHOST7 = 1 THEN GOTO DIMLY_ROOM_UNKILL1
IF (INPUTT$ = "N" OR INPUTT$ = "W" OR INPUTT$ = "S") AND GHOST7 = 1 THEN GOTO DIMLY_ROOM_GHOST3
IF (INPUTT$ = "N" OR INPUTT$ = "W" OR INPUTT$ = "S") AND GHOST3 = 1 THEN MESSAGE$ = "THE GHOST WILL NOT LET YOU PASS!": GOSUB MESSAGE: GOTO INPUT19
IF INPUTT$ = "LOOK" THEN GOTO DIMLY_ROOM_GHOST3
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT19
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT19
DIMLY_ROOM_UNKILL1: ' DIMLY LIT ROOM WITH UNKILLABLE GHOST
MESSAGE$ = "YOU ARE IN A DIMLY LIT ROOM.^THERE IS A GHOST HERE.": GOSUB MESSAGE
INPUT20: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "KILL GHOST" AND SWORD = 1 THEN GHOST4 = 0: GHOST8 = 1: MESSAGE$ = "YOUR MAGIC SWORD ENABLES YOU TO KILL THE GHOST!": GOSUB MESSAGE: GOTO INPUT20
IF INPUTT$ = "KILL GHOST" AND SWORD = 0 THEN MESSAGE$ = "YOU CAN'T KILL A GHOST WITH YOUR BARE HANDS.": GOSUB MESSAGE: GOTO INPUT20
IF INPUTT$ = "KILL SWORD" THEN MESSAGE$ = "OUCH! YOU HURT YOUR HAND.": GOSUB MESSAGE: GOTO INPUT20
IF INPUTT$ = "DROP SWORD" AND SWORD = 1 THEN SWORD = 0: MESSAGE$ = "OK": GOSUB MESSAGE: GOTO INPUT20
IF INPUTT$ = "DROP SWORD" AND SWORD = 0 THEN MESSAGE$ = "YOU'RE NOT CARRYING IT.": GOSUB MESSAGE: GOTO INPUT20
IF INPUTT$ = "E" THEN GOTO DIMLY_ROOM_GHOST3
IF INPUTT$ = "N" AND SWORD = 0 AND SOUTH = 1 THEN GOTO DIMLY_ROOM_UNKILL2
IF INPUTT$ = "S" AND SWORD = 0 THEN SOUTH = 1: GOTO DIMLY_ROOM_UNKILL1
IF (INPUTT$ = "N" OR INPUTT$ = "S" OR INPUTT$ = "W") AND SWORD = 1 THEN MESSAGE$ = "THE GHOST WILL NOT LET YOU PASS!": GOSUB MESSAGE: GOTO INPUT20
IF INPUTT$ = "LOOK" THEN GOTO DIMLY_ROOM_UNKILL1
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT20
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT20
DIMLY_ROOM_UNKILL2: ' DIMLY LIT ROOM WITH UNKILLABLE GHOST
MESSAGE$ = "YOU ARE IN A DIMLY LIT ROOM.^THERE IS A GHOST HERE.": GOSUB MESSAGE
INPUT21: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "DROP SWORD" AND SWORD = 0 THEN MESSAGE$ = "YOU'RE NOT CARRYING IT.": GOSUB MESSAGE: GOTO INPUT21
IF INPUTT$ = "KILL SWORD" THEN MESSAGE$ = "OUCH! YOU HURT YOUR HAND.": GOSUB MESSAGE: GOTO INPUT21
IF INPUTT$ = "KILL GHOST" AND SWORD = 0 THEN MESSAGE$ = "YOU CAN'T KILL A GHOST WITH YOUR BARE HANDS.": GOSUB MESSAGE: GOTO INPUT21
IF INPUTT$ = "E" THEN GOTO DIMLY_ROOM_GHOST3
IF INPUTT$ = "W" THEN GOTO DIMLY_ROOM_UNKILL3
IF INPUTT$ = "S" THEN GOTO DIMLY_ROOM_UNKILL1
IF INPUTT$ = "LOOK" OR INPUTT$ = "N" THEN GOTO DIMLY_ROOM_UNKILL2
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT21
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT21
DIMLY_ROOM_UNKILL3: ' DIMLY LIT ROOM WITH UNKILLABLE GHOST
MESSAGE$ = "YOU ARE IN A DIMLY LIT ROOM.^THERE IS A GHOST HERE.": GOSUB MESSAGE
INPUT22: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "DROP SWORD" AND SWORD = 0 THEN MESSAGE$ = "YOU'RE NOT CARRYING IT.": GOSUB MESSAGE: GOTO INPUT22
IF INPUTT$ = "KILL SWORD" THEN MESSAGE$ = "OUCH! YOU HURT YOUR HAND.": GOSUB MESSAGE: GOTO INPUT22
IF INPUTT$ = "KILL GHOST" AND SWORD = 0 THEN MESSAGE$ = "YOU CAN'T KILL A GHOST WITH YOUR BARE HANDS.": GOSUB MESSAGE: GOTO INPUT22
IF INPUTT$ = "E" THEN GOTO DIMLY_ROOM_UNKILL2
IF INPUTT$ = "S" THEN GOTO DIMLY_ROOM_ENDGAME
IF INPUTT$ = "LOOK" OR INPUTT$ = "N" OR INPUTT$ = "W" THEN GOTO DIMLY_ROOM_UNKILL3
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT22
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT22
DIMLY_ROOM_ENDGAME: ' DIMLY LIT ROOM, END OF GAME
MESSAGE$ = "YOU ARE IN A DIMLY LIT ROOM.^THERE IS A RUSTY OLD SIGN LAYING ON THE GROUND.": GOSUB MESSAGE
INPUT23: INPUT ":", INPUTT$: GOSUB CAPITOLS
IF INPUTT$ = "GET" OR INPUTT$ = "READ" OR INPUTT$ = "OPEN" OR INPUTT$ = "DROP" OR INPUTT$ = "POUR" OR INPUTT$ = "DRINK" OR INPUTT$ = "SMASH" THEN GOSUB GETNOUN
IF INPUTT$ = "PAPER" OR INPUTT$ = "KEY" OR INPUTT$ = "KNIFE" OR INPUTT$ = "ROPE" OR INPUTT$ = "ARMOR" OR INPUTT$ = "CABINET" OR INPUTT$ = "SCROLL" OR INPUTT$ = "SWORD" OR INPUTT$ = "SIGN" THEN GOSUB GETVERB
IF INPUTT$ = "GET SIGN" THEN SIGN = 1: MESSAGE$ = "OK": GOSUB MESSAGE: GOTO INPUT23
IF INPUTT$ = "READ SIGN" AND SIGN = 0 THEN MESSAGE$ = "YOU ARE NOT CARRYING IT.": GOTO INPUT23
IF INPUTT$ = "READ SIGN" AND SIGN = 1 THEN READSIGN = 1: MESSAGE$ = "THE SIGN SAYS, %THERE ARE THREE EXITS FROM THIS ROOM. ONLY ONE IS TRUE...^YOU MUST KNOW, BUT NOT BE BURDENED BY THIS CLUE!.%": GOSUB MESSAGE: GOTO INPUT23
IF INPUTT$ = "DROP SIGN" THEN SIGN = 0: MESSAGE$ = "OK": GOSUB MESSAGE: GOTO INPUT23
IF INPUTT$ = "N" THEN GOTO DIMLY_ROOM_UNKILL2
IF INPUTT$ = "E" OR INPUTT$ = "W" OR INPUTT$ = "S" THEN
IF SIGN = 1 OR READSIGN = 0 THEN
MESSAGE$ = "YOU FALL THROUGH A TRAP DOOR TO YOUR DEATH!": GOSUB MESSAGE: END
ELSE MESSAGE$ = "YOU WALK THROUGH A DOOR AND FIND YOURSELF ON A BALCONY.^YOU CLIMB DOWN A TREE AND ESCAPE TO SAFETY!^CONGRATULATIONS! YOU MADE IT!": GOSUB MESSAGE: END
END IF
END IF
IF INPUTT$ = "LOOK" THEN GOTO DIMLY_ROOM_ENDGAME
IF INPUTT$ = "QUIT" THEN END
IF INPUTT$ = "INVENT" OR INPUTT$ = "I" OR INPUTT$ = "INVENTORY" THEN GOSUB INVENTORY: GOTO INPUT23
MESSAGE$ = "I DON'T UNDERSTAND.": GOSUB MESSAGE: GOTO INPUT23
CAPITOLS:
FOR Z = 1 TO LEN(INPUTT$)
Y = ASC(MID$(INPUTT$, Z, 1))
IF Y > 96 AND Y < 123 THEN MID$(INPUTT$, Z, 1) = CHR$(Y - 32)
NEXT
RETURN
MESSAGE:
FOR Z = 1 TO LEN(MESSAGE$)
CHAR$ = MID$(MESSAGE$, Z, 1)
IF CHAR$ = "^" THEN PRINT: CHAR$ = ""
IF CHAR$ = "%" THEN PRINT CHR$(34); ELSE PRINT CHAR$;
_DELAY .03
NEXT: PRINT
RETURN
INVENTORY:
IF PAPER = 1 THEN MESSAGE$ = "CRUMPLED PAPER": GOSUB MESSAGE
IF KEYY = 1 THEN MESSAGE$ = "KEY": GOSUB MESSAGE
IF KNIFE = 1 THEN MESSAGE$ = "KNIFE": GOSUB MESSAGE
IF ROPE = 1 THEN MESSAGE$ = "ROPE": GOSUB MESSAGE
IF BUCKET = 1 THEN MESSAGE$ = "WATER BUCKET": GOSUB MESSAGE
IF SCROLL = 1 THEN MESSAGE$ = "SCROLL": GOSUB MESSAGE
IF SWORD = 1 THEN MESSAGE$ = "MAGIC SWORD": GOSUB MESSAGE
IF SIGN = 1 THEN MESSAGE$ = "RUSTY SIGN": GOSUB MESSAGE
RETURN
GETNOUN:
VERB$ = INPUTT$
INPUT "WHAT? ", NOUN$
INPUTT$ = VERB$ + " " + NOUN$
RETURN
GETVERB:
NOUN$ = INPUTT$
INPUT "WHAT DO YOU WANT ME TO DO WITH IT? ", VERB$
INPUTT$ = VERB$ + " " + NOUN$
RETURN
|
|
|
| Epicycles |
|
Posted by: bobalooie - 10-29-2022, 01:52 PM - Forum: Programs
- Replies (8)
|
 |
A few years ago a friend of mine and I were talking about epicycles, which had been used in an attempt to explain planetary motion (yes, we are both nerds.) I had decided to experiment with animating epicycle orbits. The original version of this program was written in FreeBASIC, this is my QB64PE translation of that program as an exercise to learn about the graphics capability of QB64PE. (interestingly, the two BASICs have fairly similar graphics facilities.)
Hopefully the comments in the code provide enough explanation of how I approached the problem.
Code: (Select All) 'Program: Epicycles.bas
'Purpose: A QB64PE version of Epicycles
'Version: 0.1
'Create Date: 09/23/2022
'Rev Date: 10/28/2022
OPTION _EXPLICIT
CONST PI2 = 6.2831853
TYPE ScreenPoint
x AS LONG
y AS LONG
END TYPE
DIM AS INTEGER ix 'general purpose use
DIM AS STRING sx 'general purpose use
DIM SHARED AS LONG lw, lh 'desktop width and height
DIM AS LONG MinX, MinY, MaxX, MaxY 'Cartesian limits of the images
DIM AS LONG r1, r2, r3 'radii of the epicycle circles
DIM AS LONG rot1, rot2, rot3 'rotation direction
DIM AS LONG step1, step2, step3 'rotation speed
DIM AS ScreenPoint sp1, sp2, sp3 'center points of the epicycle circles
DIM AS DOUBLE Angle1, Angle2, Angle3, AngleStep(1 TO 3)
DIM AS LONG lWin1, lWin2, lWin3 'handles for the three images
' The first image is the visible one. The second image plots each successive
' endpoint of the epicycle to build the pattern. The third image is where the
' epicycles are plotted. Put the second image on the third image, draw the
' epicycle on the third image, put the third image on the first image.
'set up the images and coords
lw = _DESKTOPWIDTH
lh = _DESKTOPHEIGHT
lWin1 = _NEWIMAGE(lw, lh, 32)
lWin2 = _NEWIMAGE(lw, lh, 32)
lWin3 = _NEWIMAGE(lw, lh, 32)
MaxX = lw \ 2: MinX = -MaxX
MaxY = lh \ 2: MinY = -MaxY
r1 = r2 = r3 = 0
_DEST lWin1: WINDOW (MinX, MinY)-(MaxX, MaxY) 'set to Cartesian coords
_DEST lWin2: WINDOW (MinX, MinY)-(MaxX, MaxY) 'set to Cartesian coords
_DEST lWin3: WINDOW (MinX, MinY)-(MaxX, MaxY) 'set to Cartesian coords
SCREEN lWin1: _DEST lWin1: _FULLSCREEN
'Get the user input
CLS
COLOR _RGB(255, 0, 255): PRINT "EPICYCLES DEMONSTRATION"
COLOR _RGB(0, 255, 255)
PRINT "Screen resolution is "; lw; " wide x "; lh; " high."
DO
LOCATE 3, 1: PRINT " "
LOCATE 3, 1: COLOR _RGB(0, 255, 255)
PRINT "Number of epicycles (1 or 2)";: INPUT ix
IF ix = 1 OR ix = 2 THEN EXIT DO
COLOR _RGB(255, 0, 0): PRINT "Try again please."
LOOP
' show how this works
DrawExamples ix
DO
LOCATE 5, 1: COLOR _RGB(0, 255, 255)
PRINT "Enter a value for the main circle radius (1 to "; STR$(MaxY * 0.5); " )"
PRINT "or 0 to quit:"
INPUT r1
IF r1 = 0 THEN END
IF r1 > 0 AND r1 <= MaxY * 0.5 THEN EXIT DO
LOCATE 7, 1: PRINT " " 'clear the input
COLOR _RGB(255, 0, 0): PRINT "Try again please.";
LOOP
DO
LOCATE 8, 1: COLOR _RGB(0, 255, 255)
PRINT "Rotate clockwise (CW) or counterclockwise (CCW)"
INPUT sx
SELECT CASE sx
CASE "CW", "cw"
rot1 = -1
EXIT DO
CASE "CCW", "ccw"
rot1 = 1
EXIT DO
CASE ELSE
LOCATE 9, 1: PRINT " "
COLOR _RGB(255, 0, 0): PRINT "Try again please."
END SELECT
LOOP
DO
LOCATE 10, 1: COLOR _RGB(0, 255, 255): PRINT "Rotational speed (1, 2 or 3)?"
INPUT sx
SELECT CASE sx
CASE "1"
step1 = 1
EXIT DO
CASE "2"
step1 = 2
EXIT DO
CASE "3"
step1 = 3
EXIT DO
CASE ELSE
LOCATE 11, 1: PRINT " " 'clear the input
COLOR _RGB(255, 0, 0): PRINT "Try again please."
END SELECT
LOOP
DO
LOCATE 12, 1: COLOR _RGB(0, 255, 255): PRINT "Enter a value for the orbiting circle radius r2 (0 to "; STR$(MaxY * 0.50); ")"
INPUT r2
IF r2 > 0 AND r2 <= (MaxY * 0.50) THEN EXIT DO
LOCATE 13, 1: PRINT " "
COLOR _RGB(255, 0, 0): PRINT "Try again please."
LOOP
DO
LOCATE 14, 1: COLOR _RGB(0, 255, 255): PRINT "Rotate clockwise (CW) or counterclockwise (CCW)"
INPUT sx
SELECT CASE sx
CASE "CW", "cw":
rot2 = -1
EXIT DO
CASE "CCW", "ccw"
rot2 = 1
EXIT DO
CASE ELSE
LOCATE 15, 1: PRINT " " 'clear the input
COLOR _RGB(255, 0, 0): PRINT "Try again please."
END SELECT
LOOP
DO
LOCATE 16, 1: COLOR _RGB(0, 255, 255): PRINT "Rotational speed (1, 2 or 3)?"
INPUT sx
SELECT CASE sx
CASE "1"
step2 = 1
EXIT DO
CASE "2"
step2 = 2
EXIT DO
CASE "3"
step2 = 3
EXIT DO
CASE ELSE
LOCATE 17, 1: PRINT " " 'clear the input
COLOR _RGB(255, 0, 0): PRINT "Try again please."
END SELECT
LOOP
step3 = step1 'set a default value
IF (ix = 2) THEN
DO
LOCATE 18, 1: COLOR _RGB(0, 255, 255)
PRINT "Enter a value for the orbiting circle radius r2 (0 to "; STR$(MaxY * 0.25); ")"
INPUT r3
IF r3 > 0 AND r3 <= (MaxY * 0.25) THEN EXIT DO
LOCATE 19, 1: PRINT " "
COLOR _RGB(255, 0, 0): PRINT "Try again please."
LOOP
DO
LOCATE 20, 1: COLOR _RGB(0, 255, 255): PRINT "Rotate clockwise (CW) or counterclockwise (CCW)"
INPUT sx
SELECT CASE sx
CASE "CW", "cw":
rot3 = -1
EXIT DO
CASE "CCW", "ccw"
rot3 = 1
EXIT DO
CASE ELSE
LOCATE 21, 1: PRINT " " 'clear the input
COLOR _RGB(255, 0, 0): PRINT "Try again please."
END SELECT
LOOP
DO
LOCATE 22, 1: COLOR _RGB(0, 255, 255): PRINT "Rotational speed (1, 2 or 3)?"
INPUT sx
SELECT CASE sx
CASE "1"
step3 = 1
EXIT DO
CASE "2"
step3 = 2
EXIT DO
CASE "3"
step3 = 3
EXIT DO
CASE ELSE
LOCATE 23, 1: PRINT " " 'clear the input
COLOR _RGB(255, 0, 0): PRINT "Try again please."
END SELECT
LOOP
END IF
PRINT "Press any key to begin."
SLEEP
'-- now the fun stuff
'Use the horizontal screen size as the step size to orbit the satellite.
'use the vertical screen size to orbit the epicycle
AngleStep(1) = PI2 / lw
AngleStep(2) = PI2 / lh
AngleStep(3) = AngleStep(1) * 3
Angle1 = Angle2 = Angle3 = 0
_LIMIT 100
'Screen lWin2 tracks the epicycle points, make sure it is cleared
_DEST lWin2: CLS
'Draw a couple axes
LINE (MinX, 0)-(MaxX, 0), _RGB(64, 64, 64)
LINE (0, MinY)-(0, MaxY), _RGB(64, 64, 64)
COLOR _RGB(0, 255, 255): LOCATE 1, 1: PRINT "Press any key to exit."
DO
WHILE INKEY$ <> "": WEND 'clear the key buffer
Angle1 = Angle1 + AngleStep(step1) * rot1
IF Angle1 > PI2 THEN Angle1 = 0 'gone around one full revolution
FindCirclePoint r1, Angle1, sp1
Angle2 = Angle2 + AngleStep(step2) * rot2
IF Angle2 > PI2 THEN Angle2 = 0 'gone around one full revolution
FindCirclePoint r2, Angle2, sp2
sp2.x = sp2.x + sp1.x: sp2.y = sp2.y + sp1.y
Angle3 = Angle3 + AngleStep(step3) * rot3
IF Angle3 > PI2 THEN Angle3 = 0 'gone around one full revolution
FindCirclePoint r3, Angle3, sp3
sp3.x = sp3.x + sp2.x: sp3.y = sp3.y + sp2.y
'track the epicycle
_DEST lWin2
PSET (sp3.x, sp3.y), _RGB(0, 0, 255)
_PUTIMAGE , lWin2, lWin3
'draw the epicycles
_DEST lWin3
'Circles
CIRCLE (0, 0), 2, _RGB(255, 255, 255)
CIRCLE (sp1.x, sp1.y), 2, _RGB(255, 255, 255)
CIRCLE (sp2.x, sp2.y), 2, _RGB(255, 255, 255)
CIRCLE (sp3.x, sp3.y), 2, _RGB(255, 255, 255)
'Radius lines
LINE (0, 0)-(sp1.x, sp1.y), _RGB(255, 0, 255)
LINE (sp1.x, sp1.y)-(sp2.x, sp2.y), _RGB(255, 255, 0)
LINE (sp2.x, sp2.y)-(sp3.x, sp3.y), _RGB(0, 255, 0)
_PUTIMAGE , lWin3, lWin1
LOOP WHILE INKEY$ = ""
' clean up
_FULLSCREEN _OFF
SCREEN 0: _DEST 0
_FREEIMAGE lWin1: _FREEIMAGE lWin2: _FREEIMAGE lWin3
END
'-------------------------- end of program -----------------------------------
SUB DrawExamples (num AS INTEGER)
DIM AS ScreenPoint sp1, sp2, sp3
DIM AS INTEGER ix, iy
'-- draw the example circles
CIRCLE (0, 0), 2, _RGB(255, 255, 255) 'center of main circle
CIRCLE (0, 0), lh \ 4, _RGB(255, 0, 0) 'main circle
ix = (lh \ 4) * COS(PI2 \ 8)
sp1.x = ix: sp1.y = ix
CIRCLE (sp1.x, sp1.y), 2, _RGB(255, 255, 255) 'center of orbiting circle
CIRCLE (sp1.x, sp1.y), lh \ 6, _RGB(255, 0, 0) 'orbiting circle
sp2.x = sp1.x + lh \ 6
sp2.y = sp1.y
CIRCLE (sp2.x, sp2.y), 2, _RGB(255, 255, 255)
LINE (0, 0)-(sp1.x, sp1.y), _RGB(255, 0, 255) 'main circle radius
LINE (sp1.x, sp1.y)-(sp2.x, sp2.y), _RGB(255, 255, 0) 'orbiting circle radius
IF (num = 2) THEN
ix = (lh \ 10) * COS(PI2 \ 8)
sp3.x = sp2.x + ix
sp3.y = sp2.y - ix
CIRCLE (sp2.x, sp2.y), _HYPOT(sp3.x - sp2.x, sp3.y - sp2.y), _RGB(255, 0, 0) 'orbiting circle
CIRCLE (sp3.x, sp3.y), 2, _RGB(255, 255, 255) 'center of orbiting circle
LINE (sp2.x, sp2.y)-(sp3.x, sp3.y), _RGB(255, 255, 0) 'orbiting circle radius
ix = (sp3.x \ 8): iy = sp3.y \ 8
COLOR _RGB(255, 255, 255)
END IF
END SUB
'-----------------------------------------------------------------------------
SUB FindCirclePoint (r AS INTEGER, a AS DOUBLE, st AS ScreenPoint)
' calculate the offset X and Y of a point given a radius and angle
' Assume the offset is from 0,0. Add the returned offsets to the previous point.
' Angle must be in radians
st.x = INT(r * COS(a)): st.y = INT(r * SIN(a))
END SUB
|
|
|
|
| simple 2D vector graphics part 2: moving in the direction of an angle |
|
Posted by: madscijr - 10-28-2022, 07:02 PM - Forum: Works in Progress
- Replies (4)
|
 |
Now given an angle in degrees (0-359) we can calculate dx and dy needed to move in that direction.
(Next - rotating objects!)
Enjoy!
Code: (Select All) _Title "Simple vector graphics v0.22 mostly by madscijr" ' display in the Window's title bar
' Simple test of vector graphics,
' borrowed graphics objects and format from Widescreen Asteroids by Terry Ritchie.
' DONE:
' * define vector objects line by line and draw to screen
' * translate rotation angle into dx,dy to move in direction of angle
' TO DO:
' * rotate objects
' * detect collisions
' * move back to storing vector object definitions in a file instead of DATA statements
' * object editor to draw/edit with the mouse/keyboard and save the coordinates
' * speed up?
' BOOLEAN CONSTANTS
Const FALSE = 0
Const TRUE = Not FALSE
' HOLDS POSITION AND VELOCITY OF ALL OBJECTS
Type ObjectType
x As Integer
y As Integer
dx As Integer
dy As Integer
cx As Integer
cy As Integer
IsEnabled As Integer
End Type ' ObjectType
' HOLDS DEFINITION OF ALL OBJECTS
Type CoordType
x1 As Integer
y1 As Integer
x2 As Integer
y2 As Integer
color As _Unsigned Long
IsLast As Integer
End Type ' CoordType
' ENABLE / DISABLE DEBUG CONSOLE
Dim Shared m_bDebug As Integer: m_bDebug = TRUE
' BASIC PROGRAM METADATA
Dim Shared m_ProgramPath$: m_ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))
Dim Shared m_ProgramName$: m_ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)
' OBJECT VARIABLES
ReDim Shared m_arrObject(1 To 8) As ObjectType
ReDim Shared m_arrLines(1 To 8, 1 To 32) As CoordType ' (object #, line segment #)
' ****************************************************************************************************************************************************************
' ACTIVATE DEBUGGING WINDOW
If m_bDebug = TRUE Then
$Console
_Delay 4
_Console On
_Echo "Started " + m_ProgramName$
_Echo "Debugging on..."
End If
' ****************************************************************************************************************************************************************
' =============================================================================
' START THE MAIN ROUTINE
main
' =============================================================================
' FINISH
'Screen 0
'Print m_ProgramName$ + " finished."
'Sleep
' ****************************************************************************************************************************************************************
' DEACTIVATE DEBUGGING WINDOW
If m_bDebug = TRUE Then
_Console Off
End If
' ****************************************************************************************************************************************************************
System ' return control to the operating system
'End
' ################################################################################################################################################################
' BEGIN MAIN MENU
' ################################################################################################################################################################
' /////////////////////////////////////////////////////////////////////////////
Sub main
Dim RoutineName As String: RoutineName = "main"
Dim in$
Dim bFinished As Integer: bFinished = FALSE
Dim result$: result$ = ""
Dim iScreen&
' SET UP SCREEN
iScreen& = _NewImage(800, 640, 32) ' 100 text columns x 40 text rows
_ScreenMove 0, 0
' MAIN MENU LOOP, UNTIL QUIT
Do
Screen iScreen&: Cls
Print m_ProgramName$
Print
Print "Simple vector drawing"
Print
Print "1) Draw vector objects "
Print "2) Calculate dx,dy per angle "
Print "3) Rotate vector objects <- UNDER CONSTRUCTION"
Print "4) Collision detection <- UNDER CONSTRUCTION"
Print
Print "Q) Exit program"
Do
in$ = InKey$
If UCase$(in$) = "Q" Then
bFinished = TRUE: Exit Do
ElseIf UCase$(in$) = "1" Then
DrawVectorObjectTest1: Exit Do
ElseIf UCase$(in$) = "2" Then
Calculate_DX_DY_per_angle_TEST_2: Exit Do
ElseIf UCase$(in$) = "3" Then
result$ = "UNDER CONSTRUCTION": Exit Do
ElseIf UCase$(in$) = "4" Then
result$ = "UNDER CONSTRUCTION": Exit Do
End If
Loop
If Len(result$) > 0 Then
Screen iScreen&: Cls
Print result$
Print
Print "Press <ENTER> to continue."
Do: Loop Until InKey$ = Chr$(13)
_KeyClear
result$ = ""
End If
Loop Until bFinished = TRUE
End Sub ' main
' ################################################################################################################################################################
' END MAIN MENU
' ################################################################################################################################################################
' /////////////////////////////////////////////////////////////////////////////
' Precalculates dx,dy for 0-359 degrees
' and returns as 2 arrays (one for dx, one for dy)
' Helped by code from
' https://wiki.qb64.dev/qb64wiki/index.php/SIN
Sub Calculate_DX_DY_per_angle (arrAngleToDX() As Single, arrAngleToDY() As Single)
Dim PI As Single
Dim iDegree As Integer
Dim sngRadians As Single
Dim iAngle As Integer
Dim iDiff As Integer
' Make sure arrays are dimensioned
ReDim arrAngleToDX(0 To 359) As Single
ReDim arrAngleToDY(0 To 359) As Single
' Calculate Pi
PI = 4 * Atn(1)
' Calculate dx,dy for each of 360 degrees
For iDegree = 0 To 359
' re-orient so 0 degrees is 12 o'clock, 180 degrees is 6 o'clock
If iDegree <= 180 Then
iAngle = 180 - iDegree
ElseIf iDegree = 181 Then
iDiff = 178
iAngle = iDegree + iDiff
Else
iDiff = iDiff - 2
iAngle = iDegree + iDiff
End If
' calculate dx, dy for the current angle
sngRadians = iDegree * PI / 180
arrAngleToDX(iAngle) = Sin(sngRadians)
arrAngleToDY(iAngle) = Cos(sngRadians)
Next iDegree
End Sub ' Calculate_DX_DY_per_angle
'Sub Calculate_DX_DY_per_angle_TEST_1
' Dim arrAngleToDX(0 To 359) As Single
' Dim arrAngleToDY(0 To 359) As Single
' Dim iAngle As Integer
' Dim in$
'
' Calculate_DX_DY_per_angle arrAngleToDX(), arrAngleToDY()
'
' for iAngle = 0 to 359
' DebugPrint _
' LeftPadString$(cstr$(iAngle), 3, " ") + " deg. " + _
' "DX=" + SngRoundedToStr$(arrAngleToDX(iAngle), 6) + " " + _
' "DY=" + SngRoundedToStr$(arrAngleToDY(iAngle), 6) + " " + _
' ""
' next iAngle
'
' Input "Press <ENTER> to continue", in$
'End Sub ' Calculate_DX_DY_per_angle_TEST_1
' /////////////////////////////////////////////////////////////////////////////
Sub Calculate_DX_DY_per_angle_TEST_2
Dim RoutineName As String: RoutineName = "Calculate_DX_DY_per_angle_TEST_2"
Dim iFPS As Integer: iFPS = 120
Dim iMinX As Integer: iMinX = 0
Dim iMaxX As Integer: iMaxX = 800
Dim iMinY As Integer: iMinY = 0
Dim iMaxY As Integer: iMaxY = 640
Dim arrAngleToDX(0 To 359) As Single
Dim arrAngleToDY(0 To 359) As Single
Dim iAngle As Integer
Dim iX As Integer
Dim iY As Integer
Dim sngX As Single
Dim sngY As Single
Dim sngVX As Single: sngVX = 4
Dim sngVY As Single: sngVY = 4
Dim sngDX As Single
Dim sngDY As Single
Dim bQuit As Integer: bQuit = FALSE
Dim in$
Calculate_DX_DY_per_angle arrAngleToDX(), arrAngleToDY()
Screen _NewImage(800, 640, 32) ' 100 text columns x 40 text rows
_KeyClear
While TRUE = TRUE
For iAngle = 0 To 359
' CALCULATE DIRECTION FOR ANGLE
sngDX = sngVX * arrAngleToDX(iAngle)
sngDY = sngVY * arrAngleToDY(iAngle)
' Start in center
iX = iMaxX \ 2: sngX = iX
iY = iMaxY \ 2: sngY = iY
' Move object outward at current iAngle
While TRUE = TRUE
' CLEAR SCREEN
_Dest 0: Cls , cBlack
' DRAW CIRCLE
' CIRCLE (x, y), radius, color
'CIRCLE [[[STEP]]](column, row), radius%, [drawColor%][, startRadian!, stopRadian!] [, aspect!]
'Circle (dblX + 4, dblY + 8), 4, cGray
iX = SngToInt%(sngX)
iY = SngToInt%(sngY)
'Line (iLoop * 8, iHeight * 16)-(iLoop * 8 + 8, _Height), cGray, BF
'Circle (iX, iY), 4, cRed
DrawCircleSolid iX, iY, 8, cRed
' SHOW VALUES
PrintAt 1, 1, RoutineName
PrintAt 3, 1, _
"iAngle=" + LeftPadString$(cstr$(iAngle), 3, " ")
PrintAt 5, 1, _
"iX =" + LeftPadString$(cstr$(iX), 3, " ") + " " + _
"sngDX =" + SngRoundedToStr$(sngDX, 6)
PrintAt 7, 1, _
"iY =" + LeftPadString$(cstr$(iY), 3, " ") + " " + _
"sngDY =" + SngRoundedToStr$(sngDY, 6)
Color cWhite, cBlue
PrintAt 9, 1, "Press ESC to exit."
Color cWhite, cEmpty
' MOVE OBJECT
sngX = sngX + sngDX
sngY = sngY + sngDY
' PROCESS INPUT
While _DeviceInput(1): Wend ' clear and update the keyboard buffer
' IF OUT OF BOUNDS, GOTO NEXT ANGLE
If iX < 0 Or iX > iMaxX Or iY < 0 Or iY > iMaxY Then
Exit While
End If
'If _Button(KeyCode_A%) Then
' Exit While
'end if
' QUIT?
If _Button(KeyCode_Escape%) Then
bQuit = TRUE
Exit While
End If
' CLEAR KEYBOARD BUFFER
_KeyClear
' UPDATE THE SCREEN
_Display
' CONTROL GAME SPEED
_Limit iFPS
Wend
If bQuit = TRUE Then Exit For
Next iAngle
If bQuit = TRUE Then Exit While
Wend
' RETURN TO AUTODISPLAY
_AutoDisplay
'Input "Press <ENTER> to continue", in$
End Sub ' Calculate_DX_DY_per_angle_TEST_2
' /////////////////////////////////////////////////////////////////////////////
Sub DrawVectorObjectTest1
Dim RoutineName As String: RoutineName = "DrawVectorObjectTest1"
Dim iFPS As Integer: iFPS = 120
Dim iLoop As Integer
Dim iObject As Integer
Dim iLine As Integer
Dim imgBack&
Dim imgMiddle&
Dim imgFront&
Dim iWhich As Integer: iWhich = 1
Dim bQuit As Integer: bQuit = FALSE
Dim in$
Dim sError As String: sError = ""
Dim iX As Integer
Dim iY As Integer
Dim sKey As String
Dim iMinX As Integer: iMinX = 0
Dim iMaxX As Integer: iMaxX = 800
Dim iMinY As Integer: iMinY = 0
Dim iMaxY As Integer: iMaxY = 640
Dim iPrintX As Integer
Dim iPrintY As Integer
' =============================================================================
' INITIALIZE
Screen _NewImage(800, 640, 32) ' 100 text columns x 40 text rows
'imgBack& = _NewImage(800, 640, 32) ' background
'imgMiddle& = _NewImage(800, 640, 32) ' other stuff
'imgFront& = _NewImage(800, 640, 32) ' foreground
' =============================================================================
' START NEW GAME
Do
_KeyClear
' CONFIGURE PRINTING FOR _PrintString
_PrintMode _FillBackground
'_PrintMode _KEEPBACKGROUND
' INIT VARS
sKey = ""
iX = 0: iY = 0
For iObject = LBound(m_arrObject) To UBound(m_arrObject)
m_arrObject(iObject).IsEnabled = FALSE
m_arrObject(iObject).x = iX
m_arrObject(iObject).y = iY
m_arrObject(iObject).dx = RandomNumber%(-5, 5)
m_arrObject(iObject).dy = RandomNumber%(-5, 5)
m_arrObject(iObject).cx = 0
m_arrObject(iObject).cy = 0
iX = iX + 200
If iX > 800 Then
iX = 0
iY = iY + 200
If iY > 640 Then
iY = 0
iX = 100
End If
End If
Next iObject
InitVectorObjects
' MAIN LOOP
While TRUE = TRUE
' REDRAW BACKGROUND LAYERS
DrawLayers imgBack&, imgMiddle&, imgFront&
'_Dest 0: Cls , cBlack
' -----------------------------------------------------------------------------
' BEGIN SHOW VALUES ON SCREEN
' -----------------------------------------------------------------------------
Color cWhite
PrintAt 1, 1, RoutineName
Color cYellow
PrintAt 3, 1, "Press 1-6 to select active object."
PrintAt 4, 1, "Arrow keys move active object."
Color cWhite, cBlue
PrintAt 5, 1, "Press ESC to exit."
Color cWhite, cEmpty
iPrintY = 7
For iObject = LBound(m_arrObject) To UBound(m_arrObject)
If m_arrObject(iObject).IsEnabled = TRUE Then
Color cCyan
Else
Color cGray
End If
PrintAt iPrintY, 1, "" + _
"obj #" + cstr$(iObject) + _
"(" + cstr$(m_arrObject(iObject).x) + "," + cstr$(m_arrObject(iObject).y) + ")" + _
"(" + cstr$(m_arrObject(iObject).dx) + "," + cstr$(m_arrObject(iObject).dy) + ")" + _
"(" + cstr$(m_arrObject(iObject).cx) + "," + cstr$(m_arrObject(iObject).cy) + ")" + _
""
iPrintY = iPrintY + 1
Next iObject
' SHOW INPUT
Color cLime
PrintAt 20, 1, "Controls : " + RightPadString$(sKey, 10, " ") + " "
Color cWhite
PrintAt 21, 1, "Object # : " + cstr$(iWhich)
' -----------------------------------------------------------------------------
' END SHOW VALUES ON SCREEN
' -----------------------------------------------------------------------------
' MOVE + DRAW ENABLED OBJECTS
For iObject = LBound(m_arrObject) To UBound(m_arrObject)
' Only enabled objects
If m_arrObject(iObject).IsEnabled = TRUE Then
' Move along X axis
m_arrObject(iObject).cx = m_arrObject(iObject).cx + 1
If m_arrObject(iObject).cx > (10 - Abs(m_arrObject(iObject).dx)) Then
m_arrObject(iObject).cx = 0
If m_arrObject(iObject).dx < 0 Then
m_arrObject(iObject).x = m_arrObject(iObject).x - 1
If m_arrObject(iObject).x < iMinX Then
m_arrObject(iObject).x = iMaxX
End If
ElseIf m_arrObject(iObject).dx > 0 Then
m_arrObject(iObject).x = m_arrObject(iObject).x + 1
If m_arrObject(iObject).x > iMaxX Then
m_arrObject(iObject).x = iMinX
End If
End If
End If
' Move along Y axis
m_arrObject(iObject).cy = m_arrObject(iObject).cy + 1
If m_arrObject(iObject).cy > (10 - Abs(m_arrObject(iObject).dy)) Then
m_arrObject(iObject).cy = 0
If m_arrObject(iObject).dy < 0 Then
m_arrObject(iObject).y = m_arrObject(iObject).y - 1
If m_arrObject(iObject).y < iMinY Then
m_arrObject(iObject).y = iMaxY
End If
ElseIf m_arrObject(iObject).dy > 0 Then
m_arrObject(iObject).y = m_arrObject(iObject).y + 1
If m_arrObject(iObject).y > iMaxY Then
m_arrObject(iObject).y = iMinY
End If
End If
End If
' Draw object's line segments
For iLine = LBound(m_arrLines, 2) To UBound(m_arrLines, 2)
'Line (x1%, y1%)-(x2%, y2%), arrColor(arrStars(iLoop).ColorIndex), BF
Line _
(m_arrObject(iObject).x + m_arrLines(iObject, iLine).x1, _
m_arrObject(iObject).y + m_arrLines(iObject, iLine).y1) _
- _
(m_arrObject(iObject).x + m_arrLines(iObject, iLine).x2, _
m_arrObject(iObject).y + m_arrLines(iObject, iLine).y2) _
, _
m_arrLines(iObject, iLine).color ' , BF
If m_arrLines(iObject, iLine).IsLast = TRUE Then
Exit For
End If
Next iLine
End If
Next iObject
' UPDATE THE SCREEN
_Display
' PROCESS INPUT
While _DeviceInput(1): Wend ' clear and update the keyboard buffer
sKey = ""
' QUIT?
If _Button(KeyCode_Escape%) Then
bQuit = TRUE
Exit While
End If
' OTHER INPUT 1-6 SELECTS WHICH OBJECT TO CHANGE
If _Button(KeyCode_1%) Then
sKey = sKey + "1,"
iWhich = 1
ElseIf _Button(KeyCode_2%) Then
sKey = sKey + "2,"
iWhich = 2
ElseIf _Button(KeyCode_3%) Then
sKey = sKey + "3,"
iWhich = 3
ElseIf _Button(KeyCode_4%) Then
sKey = sKey + "4,"
iWhich = 4
ElseIf _Button(KeyCode_5%) Then
sKey = sKey + "5,"
iWhich = 5
ElseIf _Button(KeyCode_6%) Then
sKey = sKey + "6,"
iWhich = 6
End If
' GET DIRECTION
If _Button(KeyCode_Left%) Then
sKey = sKey + "LEFT,"
m_arrObject(iWhich).dx = m_arrObject(iWhich).dx - 1
If m_arrObject(iWhich).dx < -10 Then m_arrObject(iWhich).dx = -10
ElseIf _Button(KeyCode_Right%) Then
sKey = sKey + "RIGHT,"
m_arrObject(iWhich).dx = m_arrObject(iWhich).dx + 1
If m_arrObject(iWhich).dx > 10 Then m_arrObject(iWhich).dx = 10
ElseIf _Button(KeyCode_Up%) Then
sKey = sKey + "UP,"
m_arrObject(iWhich).dy = m_arrObject(iWhich).dy - 1
If m_arrObject(iWhich).dy < -10 Then m_arrObject(iWhich).dy = -10
ElseIf _Button(KeyCode_Down%) Then
sKey = sKey + "DOWN,"
m_arrObject(iWhich).dy = m_arrObject(iWhich).dy + 1
If m_arrObject(iWhich).dy > 10 Then m_arrObject(iWhich).dy = 10
End If
' CLEAR KEYBOARD BUFFER
_KeyClear
' CONTROL GAME SPEED
_Limit iFPS
Wend
' UPDATE THE SCREEN
_Display
' CLEAR KEYBOARD BUFFER
_KeyClear ': _Delay 2
' PLAY ANOTHER ROUND OR QUIT?
If bQuit = FALSE Then
If bExit = FALSE Then Sleep
Color cWhite, cBlack
Else
Exit Do
End If
Loop
' RETURN TO AUTODISPLAY
_AutoDisplay
End Sub ' DrawVectorObjectTest1
' /////////////////////////////////////////////////////////////////////////////
' VECTOR OBJECT DEFINITIONS
' This version stores the vector object definitions in DATA statements
' but we will move back to storing them in an external file.
Sub InitVectorObjects
Dim RoutineName As String: RoutineName = "InitVectorObjects"
Dim iLoop As Integer
Dim iObject As Integer
Dim iLine As Integer
Dim x1 As Integer
Dim y1 As Integer
Dim x2 As Integer
Dim y2 As Integer
Dim r1 As Integer
Dim g1 As Integer
Dim b1 As Integer
iObject = 1
iLine = 1
Restore VectorData
For iLoop = 1 To 1024
Read x1
Read y1
Read x2
Read y2
Read r1
Read g1
Read b1 ' -255 means no more data, -254 means last set for this object
If b1 = -255 Then
' done with everything, finish last object & exit
m_arrLines(iObject, iLine).IsLast = TRUE
m_arrObject(iObject).IsEnabled = TRUE
Exit For
ElseIf b1 = -254 Then
' done with this object, finish & move to next
m_arrLines(iObject, iLine).IsLast = TRUE
m_arrObject(iObject).IsEnabled = TRUE
iObject = iObject + 1
iLine = 1
' if more data than array, quit
If iObject > UBound(m_arrLines, 1) Then
Exit For
End If
Else
' if more data than array,
' just keep reading until either
' we get to the next object or time to quit
If iLine <= UBound(m_arrLines, 2) Then
m_arrLines(iObject, iLine).x1 = x1
m_arrLines(iObject, iLine).y1 = y1
m_arrLines(iObject, iLine).x2 = x2
m_arrLines(iObject, iLine).y2 = y2
m_arrLines(iObject, iLine).color = _RGB32(r1, g1, b1)
m_arrLines(iObject, iLine).IsLast = FALSE
iLine = iLine + 1
End If
End If
Next iLoop%
VectorData:
' Objects are defined as a collection of line segments, in the form:
' Data {x1},{y1},{x2},{y2},{red},{green},{blue}
' where
' * {x1},{y1} are the starting point of the line
' * {x2},{y2} are the ending point of the line
' * {red},{green},{blue} are the RGB color of the line segment
' * 0,0 is the origin,
' * negative numbers mean to the left or above the origin
' * positive numbers mean to the right or below the origin
' * if the {blue} value is -254 like
' Data 0,0,0,0,-254,-254,-254
' then that line is not used,
' it just exists to tell the parser that object's definition is done,
' * if the {blue} value is -255 like
' Data 0,0,0,0,-255,-255,-255
' then that line is not used
' it just exists to tell the parser no more data, stop parsing.
' For now we're using data statements, but later might store
' these definitions in a separate file that an editor can read/write.
'objaster1 = purple
Data 2,-41,31,-50,128,0,255
Data 31,-50,56,-23,128,0,255
Data 56,-23,37,-10,128,0,255
Data 37,-10,61,13,128,0,255
Data 61,13,32,62,128,0,255
Data 32,62,-22,43,128,0,255
Data -22,43,-40,57,128,0,255
Data -40,57,-62,34,128,0,255
Data -62,34,-47,7,128,0,255
Data -47,7,-62,-26,128,0,255
Data -62,-26,-32,-63,128,0,255
Data -32,-63,2,-41,128,0,255
Data 0,0,0,0,-254,-254,-254
'objaster2 = red
Data -28,-62,22,-62,255,0,0
Data 22,-62,61,-28,255,0,0
Data 61,-28,61,13,255,0,0
Data 61,13,23,57,255,0,0
Data 23,57,-6,62,255,0,0
Data -6,62,-6,15,255,0,0
Data -6,15,-36,47,255,0,0
Data -36,47,-59,14,255,0,0
Data -59,14,-35,1,255,0,0
Data -35,1,-62,-9,255,0,0
Data -62,-9,-28,-62,255,0,0
Data 0,0,0,0,-254,-254,-254
'objaster3 = orange
Data 9,-62,60,-21,255,165,0
Data 60,-21,62,-3,255,165,0
Data 62,-3,24,13,255,165,0
Data 24,13,53,34,255,165,0
Data 53,34,38,55,255,165,0
Data 38,55,20,40,255,165,0
Data 20,40,-37,61,255,165,0
Data -37,61,-63,15,255,165,0
Data -63,15,-57,-24,255,165,0
Data -57,-24,-24,-24,255,165,0
Data -24,-24,-38,-45,255,165,0
Data -38,-45,9,-62,255,165,0
Data 0,0,0,0,-254,-254,-254
'objmouse = yellow
Data 0,-10,6,3,255,255,0
Data 6,3,1,2,255,255,0
Data 1,2,1,10,255,255,0
Data 1,10,-1,10,255,255,0
Data -1,10,-1,2,255,255,0
Data -1,2,-6,3,255,255,0
Data -6,3,0,-10,255,255,0
Data 0,0,0,0,-254,-254,-254
'objship = cyan
Data 0,-15,10,15,0,255,255
Data 10,15,6,11,0,255,255
Data 6,11,-6,11,0,255,255
Data -6,11,-10,15,0,255,255
Data -10,15,0,-15,0,255,255
Data 0,0,0,0,-254,-254,-254
'objufo = green
Data -4,-16,4,-16,0,255,0
Data 4,-16,10,-6,0,255,0
Data 10,-6,25,5,0,255,0
Data 25,5,10,16,0,255,0
Data 10,16,-10,16,0,255,0
Data -10,16,-25,5,0,255,0
Data -25,5,-10,-6,0,255,0
Data -10,-6,-4,-16,0,255,0
Data -10,-6,10,-6,0,255,0
Data -25,5,25,5,0,255,0
Data 0,0,0,0,-255,-255,-255
End Sub ' InitVectorObjects
' /////////////////////////////////////////////////////////////////////////////
' (RE)DRAW SCREEN
Sub DrawLayers (imgBack&, imgMiddle&, imgFront&)
Dim RoutineName As String: RoutineName = "DrawLayers"
_Dest 0
Cls , cBlack
If TRUE = FALSE Then
If imgBack& < -1 Then
_PutImage , imgBack&, 0
End If
If imgMiddle& < -1 Then
_PutImage , imgMiddle&, 0
End If
If imgFront& < -1 Then
_PutImage , imgFront&, 0
End If
End If
End Sub ' DrawLayers
' ****************************************************************************************************************************************************************
' BEGIN TEST CODE
' ****************************************************************************************************************************************************************
' /////////////////////////////////////////////////////////////////////////////
'Sub TestDivideAndRound1
' Dim mySingle As Single
' Dim myDouble As Double
' Dim myFloat1 As _Float
' Dim in$
' ' Excel 1/360 = 0.002778
' mySingle = 1 / 360
' myDouble = 1 / 360
' myFloat1 = 1 / 360
' Print "Single 1/360 = " + _Trim$(Str$(mySingle)) + " or " + SngToStr$(mySingle) + " or " + SngRoundedToStr$(mySingle, 6)
' Print "Double 1/360 = " + _Trim$(Str$(myDouble)) + " or " + DblToStr$(myDouble) + " or " + DblRoundedToStr$(myDouble, 6)
' Print "_FLOAT 1/360 = " + _Trim$(Str$(myFloat1)) + " or " + FloatToStr$(myFloat1) + " or " + FloatRoundedToStr$(myFloat1, 6)
'
' Input "Press <ENTER> to continue", in$
'End Sub ' TestDivideAndRound1
' ****************************************************************************************************************************************************************
' END TEST CODE
' ****************************************************************************************************************************************************************
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GENERAL PURPOSE FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' /////////////////////////////////////////////////////////////////////////////
' Integer to string
Function cstr$ (myValue)
'cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
cstr$ = _Trim$(Str$(myValue))
End Function ' cstr$
' /////////////////////////////////////////////////////////////////////////////
' Hack function, to be replaced with something better
Function DblToInt% (dblOld As Double)
Dim dblNew As Double
Dim sValue As String
Dim iPos As Integer
dblNew = RoundDouble#(dblOld, 0)
'sValue = _Trim$(Str$(dblNew))
sValue = DblToStr$(dblNew)
'iPos = InStr(1, sValue, ".")
'If iPos > 0 Then
' DblToInt% = Val(Left$(sValue, iPos - 1))
'Else
' DblToInt% = Val(sValue)
'End If
DblToInt% = Val(sValue)
End Function ' DblToInt%
' /////////////////////////////////////////////////////////////////////////////
' Scientific notation - QB64 Wiki
' https://www.qb64.org/wiki/Scientific_notation
' Example: A string function that displays extremely small or large exponential decimal values.
Function DblToStr$ (n#)
Dim result$: result$ = ""
Dim value$
Dim Xpos%
Dim expo%
Dim sign$
Dim valu$
Dim dot%
Dim L%
Dim add$
Dim min$
Dim DP$
Dim n%
value$ = UCase$(LTrim$(Str$(n#)))
Xpos% = InStr(value$, "D") + InStr(value$, "E") ' only D or E can be present
If Xpos% Then
expo% = Val(Mid$(value$, Xpos% + 1))
If Val(value$) < 0 Then
sign$ = "-"
valu$ = Mid$(value$, 2, Xpos% - 2)
Else
valu$ = Mid$(value$, 1, Xpos% - 1)
End If
dot% = InStr(valu$, ".")
L% = Len(valu$)
If expo% > 0 Then
add$ = String$(expo% - (L% - dot%), "0")
End If
If expo% < 0 Then
min$ = String$(Abs(expo%) - (dot% - 1), "0")
DP$ = "."
End If
For n% = 1 To L%
If Mid$(valu$, n%, 1) <> "." Then
num$ = num$ + Mid$(valu$, n%, 1)
End If
Next n%
result$ = _Trim$(sign$ + DP$ + min$ + num$ + add$)
Else
result$ = value$
End If
DblToStr$ = result$
End Function ' DblToStr$
' /////////////////////////////////////////////////////////////////////////////
Function DblRoundedToStr$ (dblValue As Double, intNumPlaces As Integer)
Dim dblNew As Double
dblNew = RoundDouble#(dblValue, intNumPlaces)
DblRoundedToStr$ = DblToStr$(dblNew)
End Function ' DblRoundedToStr$
' /////////////////////////////////////////////////////////////////////////////
Function DoubleABS# (dblValue As Double)
If Sgn(dblValue) = -1 Then
DoubleABS# = 0 - dblValue
Else
DoubleABS# = dblValue
End If
End Function ' DoubleABS#
' /////////////////////////////////////////////////////////////////////////////
' bplus: The Gold Standard is even better than THE QB64 CIRCLE sub in this respect!
' https://forum.qb64.org/index.php?topic=1044.135
' from Steve Gold standard
' Renamed fcirc to DrawCircleSolid
' Not as fast as DrawCircleTopLeft but pretty fast.
' Example:
' Screen _NewImage(800, 600, 32)
' _ScreenMove 250, 60
' For r = 250 To 0 Step -60
' DrawCircleSolid 400, 300, r, _RGBA(255, 255, 255, 100)
' Next r
Sub DrawCircleSolid (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
Dim Radius As Integer, RadiusError As Integer
Dim X As Integer, Y As Integer
Radius = Abs(R)
RadiusError = -Radius
X = Radius
Y = 0
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
' Draw the middle span here so we don't draw it twice in the main loop,
' which would be a problem with blending turned on.
Line (CX - X, CY)-(CX + X, CY), C, BF
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
Wend
End Sub ' DrawCircleSolid
' /////////////////////////////////////////////////////////////////////////////
Function FloatRoundedToStr$ (fValue As _Float, intNumPlaces As Integer)
Dim fNew As _Float
fNew = Round##(fValue, intNumPlaces)
FloatRoundedToStr$ = FloatToStr$(fNew)
End Function ' DblRoundedToStr$
' /////////////////////////////////////////////////////////////////////////////
' Scientific notation - QB64 Wiki
' https://www.qb64.org/wiki/Scientific_notation
' Example: A string function that displays extremely small or large exponential decimal values.
Function FloatToStr$ (n##)
value$ = UCase$(LTrim$(Str$(n##)))
Xpos% = InStr(value$, "D") + InStr(value$, "E") 'only D or E can be present
If Xpos% Then
expo% = Val(Mid$(value$, Xpos% + 1))
If Val(value$) < 0 Then
sign$ = "-"
valu$ = Mid$(value$, 2, Xpos% - 2)
Else
valu$ = Mid$(value$, 1, Xpos% - 1)
End If
dot% = InStr(valu$, ".")
L% = Len(valu$)
If expo% > 0 Then
add$ = String$(expo% - (L% - dot%), "0")
End If
If expo% < 0 Then
min$ = String$(Abs(expo%) - (dot% - 1), "0")
DP$ = "."
End If
For n = 1 To L%
If Mid$(valu$, n, 1) <> "." Then
num$ = num$ + Mid$(valu$, n, 1)
End If
Next n
Else
FloatToStr$ = value$
Exit Function
End If
FloatToStr$ = _Trim$(sign$ + DP$ + min$ + num$ + add$)
End Function ' FloatToStr$
' /////////////////////////////////////////////////////////////////////////////
' By sMcNeill from https://www.qb64.org/forum/index.php?topic=896.0
Function IsNum% (text$)
Dim a$
Dim b$
a$ = _Trim$(text$)
b$ = _Trim$(Str$(Val(text$)))
If a$ = b$ Then
IsNum% = TRUE
Else
IsNum% = FALSE
End If
End Function ' IsNum%
' /////////////////////////////////////////////////////////////////////////////
' Split and join strings
' https://www.qb64.org/forum/index.php?topic=1073.0
'Combine all elements of in$() into a single string with delimiter$ separating the elements.
Function join$ (in$(), delimiter$)
Dim result$
Dim i As Long
result$ = in$(LBound(in$))
For i = LBound(in$) + 1 To UBound(in$)
result$ = result$ + delimiter$ + in$(i)
Next i
join$ = result$
End Function ' join$
' /////////////////////////////////////////////////////////////////////////////
Function LeftPadString$ (myString$, toWidth%, padChar$)
LeftPadString$ = Right$(String$(toWidth%, padChar$) + myString$, toWidth%)
End Function ' LeftPadString$
' /////////////////////////////////////////////////////////////////////////////
' ABS was returning strange values with type LONG
' so I created this which does not.
Function LongABS& (lngValue As Long)
If Sgn(lngValue) = -1 Then
LongABS& = 0 - lngValue
Else
LongABS& = lngValue
End If
End Function ' LongABS&
' /////////////////////////////////////////////////////////////////////////////
' iRow% and iCol% are 0-based in this version
Sub PrintAt (iRow%, iCol%, sText$)
'_PrintString (iCol% * 8, iRow% * 16), sText$
_PrintString (iCol% * 8, iRow% * 16), sText$
'_PrintString (iCol%, iRow%), sText$
End Sub ' PrintAt
' /////////////////////////////////////////////////////////////////////////////
' Generate random value between Min and Max.
Function RandomNumber% (Min%, Max%)
Dim NumSpread%
' SET RANDOM SEED
'Randomize ' Initialize random-number generator.
Randomize Timer
' GET RANDOM # Min%-Max%
'RandomNumber = Int((Max * Rnd) + Min) ' generate number
NumSpread% = (Max% - Min%) + 1
RandomNumber% = Int(Rnd * NumSpread%) + Min% ' GET RANDOM # BETWEEN Max% AND Min%
End Function ' RandomNumber%
' /////////////////////////////////////////////////////////////////////////////
Function RightPadString$ (myString$, toWidth%, padChar$)
RightPadString$ = Left$(myString$ + String$(toWidth%, padChar$), toWidth%)
End Function ' RightPadString$
' /////////////////////////////////////////////////////////////////////////////
' https://www.qb64.org/forum/index.php?topic=3605.0
' Quote from: SMcNeill on Today at 03:53:48 PM
'
' Sometimes, you guys make things entirely too complicated.
' There ya go! Three functions to either round naturally,
' always round down, or always round up, to whatever number of digits you desire.
' EDIT: Modified to add another option to round scientific,
' since you had it's description included in your example.
' Receives + returns _FLOAT myVar## (-1.18E-4932 to +1.18E+4932)
' =============================================================================
' ROUNDING FUNCTIONS FOR TYPE _FLOAT
Function Round## (num##, digits%)
Round## = Int(num## * 10 ^ digits% + .5) / 10 ^ digits%
End Function
Function RoundUp## (num##, digits%)
RoundUp## = _Ceil(num## * 10 ^ digits%) / 10 ^ digits%
End Function
Function RoundDown## (num##, digits%)
RoundDown## = Int(num## * 10 ^ digits%) / 10 ^ digits%
End Function
Function RoundScientific## (num##, digits%)
RoundScientific## = _Round(num## * 10 ^ digits%) / 10 ^ digits%
End Function
' =============================================================================
' ROUNDING FUNCTIONS FOR TYPE DOUBLE
Function RoundDouble# (num#, digits%)
RoundDouble# = Int(num# * 10 ^ digits% + .5) / 10 ^ digits%
End Function
Function RoundUpDouble# (num#, digits%)
RoundUpDouble# = _Ceil(num# * 10 ^ digits%) / 10 ^ digits%
End Function
Function RoundDownDouble# (num#, digits%)
RoundDownDouble# = Int(num# * 10 ^ digits%) / 10 ^ digits%
End Function
Function RoundScientificDouble# (num#, digits%)
RoundScientificDouble# = _Round(num# * 10 ^ digits%) / 10 ^ digits%
End Function
' =============================================================================
' ROUNDING FUNCTIONS FOR TYPE SINGLE
Function RoundSingle! (num!, digits%)
RoundSingle! = Int(num! * 10 ^ digits% + .5) / 10 ^ digits%
End Function
' NOTE: not sure this one works: when digits%=3, it rounds .31 to .32
Function RoundUpSingle! (num!, digits%)
RoundUpSingle! = _Ceil(num! * 10 ^ digits%) / 10 ^ digits%
End Function
Function RoundDownSingle! (num!, digits%)
RoundDownSingle! = Int(num! * 10 ^ digits%) / 10 ^ digits%
End Function
Function RoundScientificSingle! (num!, digits%)
RoundScientificSingle! = _Round(num! * 10 ^ digits%) / 10 ^ digits%
End Function
' /////////////////////////////////////////////////////////////////////////////
Function SmallestOf3% (i1%, i2%, i3%)
Dim iMin%
iMin% = i1%
If i2% < iMin% Then iMin% = i2%
If i3% < iMin% Then iMin% = i3%
SmallestOf3% = iMin%
End Function ' SmallestOf3
' /////////////////////////////////////////////////////////////////////////////
Function SngRoundedToStr$ (sngValue As Single, intNumPlaces As Integer)
Dim sngNew As Single
sngNew = RoundSingle!(sngValue, intNumPlaces)
SngRoundedToStr$ = SngToStr$(sngNew)
End Function ' SngRoundedToStr$
' /////////////////////////////////////////////////////////////////////////////
' Hack function, to be replaced with something better
Function SngToInt% (sngOld As Single)
Dim sngNew As Single
Dim sValue As String
Dim iPos As Integer
sngNew = RoundSingle!(sngOld, 0)
'sValue = _Trim$(Str$(sngNew))
sValue = SngToStr$(sngNew)
'iPos = InStr(1, sValue, ".")
'If iPos > 0 Then
' SngToInt% = Val(Left$(sValue, iPos - 1))
'Else
' SngToInt% = Val(sValue)
'End If
SngToInt% = Val(sValue)
End Function ' SngToInt%
' /////////////////////////////////////////////////////////////////////////////
' Scientific notation - QB64 Wiki
' https://www.qb64.org/wiki/Scientific_notation
' Example: A string function that displays extremely small or large exponential decimal values.
Function SngToStr$ (n!)
Dim result$: result$ = ""
Dim value$
Dim Xpos%
Dim expo%
Dim sign$
Dim valu$
Dim dot%
Dim L%
Dim add$
Dim min$
Dim DP$
Dim n%
value$ = UCase$(LTrim$(Str$(n!)))
Xpos% = InStr(value$, "D") + InStr(value$, "E") ' only D or E can be present
If Xpos% Then
expo% = Val(Mid$(value$, Xpos% + 1))
If Val(value$) < 0 Then
sign$ = "-"
valu$ = Mid$(value$, 2, Xpos% - 2)
Else
valu$ = Mid$(value$, 1, Xpos% - 1)
End If
dot% = InStr(valu$, ".")
L% = Len(valu$)
If expo% > 0 Then
add$ = String$(expo% - (L% - dot%), "0")
End If
If expo% < 0 Then
min$ = String$(Abs(expo%) - (dot% - 1), "0")
DP$ = "."
End If
For n% = 1 To L%
If Mid$(valu$, n%, 1) <> "." Then
num$ = num$ + Mid$(valu$, n%, 1)
End If
Next n%
result$ = _Trim$(sign$ + DP$ + min$ + num$ + add$)
Else
result$ = value$
End If
SngToStr$ = result$
End Function ' SngToStr$
' /////////////////////////////////////////////////////////////////////////////
' Split and join strings
' https://www.qb64.org/forum/index.php?topic=1073.0
'
' FROM luke, QB64 Developer
' Date: February 15, 2019, 04:11:07 AM
'
' Given a string of words separated by spaces (or any other character),
' splits it into an array of the words. I've no doubt many people have
' written a version of this over the years and no doubt there's a million
' ways to do it, but I thought I'd put mine here so we have at least one
' version. There's also a join function that does the opposite
' array -> single string.
'
' Code is hopefully reasonably self explanatory with comments and a little demo.
' Note, this is akin to Python/JavaScript split/join, PHP explode/implode.
'Split in$ into pieces, chopping at every occurrence of delimiter$. Multiple consecutive occurrences
'of delimiter$ are treated as a single instance. The chopped pieces are stored in result$().
'
'delimiter$ must be one character long.
'result$() must have been REDIMmed previously.
' Modified to handle multi-character delimiters
Sub split (in$, delimiter$, result$())
Dim start As Integer
Dim finish As Integer
Dim iDelimLen As Integer
ReDim result$(-1)
iDelimLen = Len(delimiter$)
start = 1
Do
'While Mid$(in$, start, 1) = delimiter$
While Mid$(in$, start, iDelimLen) = delimiter$
'start = start + 1
start = start + iDelimLen
If start > Len(in$) Then
Exit Sub
End If
Wend
finish = InStr(start, in$, delimiter$)
If finish = 0 Then
finish = Len(in$) + 1
End If
ReDim _Preserve result$(0 To UBound(result$) + 1)
result$(UBound(result$)) = Mid$(in$, start, finish - start)
start = finish + 1
Loop While start <= Len(in$)
End Sub ' split
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GENERAL PURPOSE FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN COLOR FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Function cRed~& ()
cRed = _RGB32(255, 0, 0)
End Function
Function cOrangeRed~& ()
cOrangeRed = _RGB32(255, 69, 0)
End Function ' cOrangeRed~&
Function cDarkOrange~& ()
cDarkOrange = _RGB32(255, 140, 0)
End Function ' cDarkOrange~&
Function cOrange~& ()
cOrange = _RGB32(255, 165, 0)
End Function ' cOrange~&
Function cGold~& ()
cGold = _RGB32(255, 215, 0)
End Function ' cGold~&
Function cYellow~& ()
cYellow = _RGB32(255, 255, 0)
End Function ' cYellow~&
' LONG-HAIRED FRIENDS OF JESUS OR NOT,
' THIS IS NOT YELLOW ENOUGH (TOO CLOSE TO LIME)
' TO USE FOR OUR COMPLEX RAINBOW SEQUENCE:
Function cChartreuse~& ()
cChartreuse = _RGB32(127, 255, 0)
End Function ' cChartreuse~&
' WE SUBSTITUTE THIS CSS3 COLOR FOR INBETWEEN LIME AND YELLOW:
Function cOliveDrab1~& ()
cOliveDrab1 = _RGB32(192, 255, 62)
End Function ' cOliveDrab1~&
Function cLime~& ()
cLime = _RGB32(0, 255, 0)
End Function ' cLime~&
Function cMediumSpringGreen~& ()
cMediumSpringGreen = _RGB32(0, 250, 154)
End Function ' cMediumSpringGreen~&
' ADDED THIS FOR THE GAUGE COLOR:
Function cSpringGreen~& ()
cSpringGreen = _RGB32(0, 255, 160)
End Function ' cSpringGreen~&
Function cCyan~& ()
cCyan = _RGB32(0, 255, 255)
End Function ' cCyan~&
Function cDeepSkyBlue~& ()
cDeepSkyBlue = _RGB32(0, 191, 255)
End Function ' cDeepSkyBlue~&
Function cDodgerBlue~& ()
cDodgerBlue = _RGB32(30, 144, 255)
End Function ' cDodgerBlue~&
Function cSeaBlue~& ()
cSeaBlue = _RGB32(0, 64, 255)
End Function ' cSeaBlue~&
Function cBlue~& ()
cBlue = _RGB32(0, 0, 255)
End Function ' cBlue~&
Function cBluePurple~& ()
cBluePurple = _RGB32(64, 0, 255)
End Function ' cBluePurple~&
Function cDeepPurple~& ()
cDeepPurple = _RGB32(96, 0, 255)
End Function ' cDeepPurple~&
Function cPurple~& ()
cPurple = _RGB32(128, 0, 255)
End Function ' cPurple~&
Function cPurpleRed~& ()
cPurpleRed = _RGB32(128, 0, 192)
End Function ' cPurpleRed~&
Function cDarkRed~& ()
cDarkRed = _RGB32(160, 0, 64)
End Function ' cDarkRed~&
Function cBrickRed~& ()
cBrickRed = _RGB32(192, 0, 32)
End Function ' cBrickRed~&
Function cDarkGreen~& ()
cDarkGreen = _RGB32(0, 100, 0)
End Function ' cDarkGreen~&
Function cGreen~& ()
cGreen = _RGB32(0, 128, 0)
End Function ' cGreen~&
Function cOliveDrab~& ()
cOliveDrab = _RGB32(107, 142, 35)
End Function ' cOliveDrab~&
Function cLightPink~& ()
cLightPink = _RGB32(255, 182, 193)
End Function ' cLightPink~&
Function cHotPink~& ()
cHotPink = _RGB32(255, 105, 180)
End Function ' cHotPink~&
Function cDeepPink~& ()
cDeepPink = _RGB32(255, 20, 147)
End Function ' cDeepPink~&
Function cMagenta~& ()
cMagenta = _RGB32(255, 0, 255)
End Function ' cMagenta~&
Function cBlack~& ()
cBlack = _RGB32(0, 0, 0)
End Function ' cBlack~&
Function cDimGray~& ()
cDimGray = _RGB32(105, 105, 105)
End Function ' cDimGray~&
Function cGray~& ()
cGray = _RGB32(128, 128, 128)
End Function ' cGray~&
Function cDarkGray~& ()
cDarkGray = _RGB32(169, 169, 169)
End Function ' cDarkGray~&
Function cSilver~& ()
cSilver = _RGB32(192, 192, 192)
End Function ' cSilver~&
Function cLightGray~& ()
cLightGray = _RGB32(211, 211, 211)
End Function ' cLightGray~&
Function cGainsboro~& ()
cGainsboro = _RGB32(220, 220, 220)
End Function ' cGainsboro~&
Function cWhiteSmoke~& ()
cWhiteSmoke = _RGB32(245, 245, 245)
End Function ' cWhiteSmoke~&
Function cWhite~& ()
cWhite = _RGB32(255, 255, 255)
'cWhite = _RGB32(254, 254, 254)
End Function ' cWhite~&
Function cDarkBrown~& ()
cDarkBrown = _RGB32(128, 64, 0)
End Function ' cDarkBrown~&
Function cLightBrown~& ()
cLightBrown = _RGB32(196, 96, 0)
End Function ' cLightBrown~&
Function cKhaki~& ()
cKhaki = _RGB32(240, 230, 140)
End Function ' cKhaki~&
Function cEmpty~& ()
'cEmpty~& = -1
cEmpty = _RGB32(0, 0, 0, 0)
End Function ' cEmpty~&
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END COLOR FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ################################################################################################################################################################
' BEGIN KEYBOARD CODE FUNCTIONS
' NOTE: ALL CODES ARE FOR _BUTTON, EXCEPT:
' cF10 (_KEYDOWN)
' cAltLeft (_KEYHIT)
' cAltRight (_KEYHIT)
' cPrintScreen (_KEYHIT) <- may slow down pc?
' cPauseBreak (_KEYHIT) <- may not work?
' ################################################################################################################################################################
Function KeyCode_Escape% ()
KeyCode_Escape% = 2
End Function
Function KeyCode_F1% ()
KeyCode_F1% = 60
End Function
Function KeyCode_F2% ()
KeyCode_F2% = 61
End Function
Function KeyCode_F3% ()
KeyCode_F3% = 62
End Function
Function KeyCode_F4% ()
KeyCode_F4% = 63
End Function
Function KeyCode_F5% ()
KeyCode_F5% = 64
End Function
Function KeyCode_F6% ()
KeyCode_F6% = 65
End Function
Function KeyCode_F7% ()
KeyCode_F7% = 66
End Function
Function KeyCode_F8% ()
KeyCode_F8% = 67
End Function
Function KeyCode_F9% ()
KeyCode_F9% = 68
End Function
'_KEYDOWN CODE, NOT _BUTTON CODE
Function KeyCode_F10% ()
KeyCode_F10% = 17408
End Function
Function KeyCode_F11% ()
KeyCode_F11% = 88
End Function
Function KeyCode_F12% ()
KeyCode_F12% = 89
End Function
'_KEYHIT CODE, NOT _BUTTON CODE
Function KeyCode_PrintScreen% ()
KeyCode_PrintScreen% = -44
End Function
Function KeyCode_ScrollLock% ()
KeyCode_ScrollLock% = 71
End Function
'_KEYHIT CODE, NOT _BUTTON CODE
Function KeyCode_PauseBreak% ()
KeyCode_PauseBreak% = 31053
End Function
Function KeyCode_Tilde% ()
KeyCode_Tilde% = 42
End Function
Function KeyCode_1% ()
KeyCode_1% = 3
End Function
Function KeyCode_2% ()
KeyCode_2% = 4
End Function
Function KeyCode_3% ()
KeyCode_3% = 5
End Function
Function KeyCode_4% ()
KeyCode_4% = 6
End Function
Function KeyCode_5% ()
KeyCode_5% = 7
End Function
Function KeyCode_6% ()
KeyCode_6% = 8
End Function
Function KeyCode_7% ()
KeyCode_7% = 9
End Function
Function KeyCode_8% ()
KeyCode_8% = 10
End Function
Function KeyCode_9% ()
KeyCode_9% = 11
End Function
Function KeyCode_0% ()
KeyCode_0% = 12
End Function
Function KeyCode_Minus% ()
KeyCode_Minus% = 13
End Function
Function KeyCode_Equal% ()
KeyCode_Equal% = 14
End Function
Function KeyCode_BkSp% ()
KeyCode_BkSp% = 15
End Function
Function KeyCode_Ins% ()
KeyCode_Ins% = 339
End Function
Function KeyCode_Home% ()
KeyCode_Home% = 328
End Function
Function KeyCode_PgUp% ()
KeyCode_PgUp% = 330
End Function
Function KeyCode_Del% ()
KeyCode_Del% = 340
End Function
Function KeyCode_End% ()
KeyCode_End% = 336
End Function
Function KeyCode_PgDn% ()
KeyCode_PgDn% = 338
End Function
Function KeyCode_NumLock% ()
KeyCode_NumLock% = 326
End Function
Function KeyCode_KeypadSlash% ()
KeyCode_KeypadSlash% = 310
End Function
Function KeyCode_KeypadMultiply% ()
KeyCode_KeypadMultiply% = 56
End Function
Function KeyCode_KeypadMinus% ()
KeyCode_KeypadMinus% = 75
End Function
Function KeyCode_Keypad7Home% ()
KeyCode_Keypad7Home% = 72
End Function
Function KeyCode_Keypad8Up% ()
KeyCode_Keypad8Up% = 73
End Function
Function KeyCode_Keypad9PgUp% ()
KeyCode_Keypad9PgUp% = 74
End Function
Function KeyCode_KeypadPlus% ()
KeyCode_KeypadPlus% = 79
End Function
Function KeyCode_Keypad4Left% ()
KeyCode_Keypad4Left% = 76
End Function
Function KeyCode_Keypad5% ()
KeyCode_Keypad5% = 77
End Function
Function KeyCode_Keypad6Right% ()
KeyCode_Keypad6Right% = 78
End Function
Function KeyCode_Keypad1End% ()
KeyCode_Keypad1End% = 80
End Function
Function KeyCode_Keypad2Down% ()
KeyCode_Keypad2Down% = 81
End Function
Function KeyCode_Keypad3PgDn% ()
KeyCode_Keypad3PgDn% = 82
End Function
Function KeyCode_KeypadEnter% ()
KeyCode_KeypadEnter% = 285
End Function
Function KeyCode_Keypad0Ins% ()
KeyCode_Keypad0Ins% = 83
End Function
Function KeyCode_KeypadPeriodDel% ()
KeyCode_KeypadPeriodDel% = 84
End Function
Function KeyCode_Tab% ()
KeyCode_Tab% = 16
End Function
Function KeyCode_Q% ()
KeyCode_Q% = 17
End Function
Function KeyCode_W% ()
KeyCode_W% = 18
End Function
Function KeyCode_E% ()
KeyCode_E% = 19
End Function
Function KeyCode_R% ()
KeyCode_R% = 20
End Function
Function KeyCode_T% ()
KeyCode_T% = 21
End Function
Function KeyCode_Y% ()
KeyCode_Y% = 22
End Function
Function KeyCode_U% ()
KeyCode_U% = 23
End Function
Function KeyCode_I% ()
KeyCode_I% = 24
End Function
Function KeyCode_O% ()
KeyCode_O% = 25
End Function
Function KeyCode_P% ()
KeyCode_P% = 26
End Function
Function KeyCode_BracketLeft% ()
KeyCode_BracketLeft% = 27
End Function
Function KeyCode_BracketRight% ()
KeyCode_BracketRight% = 28
End Function
Function KeyCode_Backslash% ()
KeyCode_Backslash% = 44
End Function
Function KeyCode_CapsLock% ()
KeyCode_CapsLock% = 59
End Function
Function KeyCode_A% ()
KeyCode_A% = 31
End Function
Function KeyCode_S% ()
KeyCode_S% = 32
End Function
Function KeyCode_D% ()
KeyCode_D% = 33
End Function
Function KeyCode_F% ()
KeyCode_F% = 34
End Function
Function KeyCode_G% ()
KeyCode_G% = 35
End Function
Function KeyCode_H% ()
KeyCode_H% = 36
End Function
Function KeyCode_J% ()
KeyCode_J% = 37
End Function
Function KeyCode_K% ()
KeyCode_K% = 38
End Function
Function KeyCode_L% ()
KeyCode_L% = 39
End Function
Function KeyCode_Semicolon% ()
KeyCode_Semicolon% = 40
End Function
Function KeyCode_Apostrophe% ()
KeyCode_Apostrophe% = 41
End Function
Function KeyCode_Enter% ()
KeyCode_Enter% = 29
End Function
Function KeyCode_ShiftLeft% ()
KeyCode_ShiftLeft% = 43
End Function
Function KeyCode_Z% ()
KeyCode_Z% = 45
End Function
Function KeyCode_X% ()
KeyCode_X% = 46
End Function
Function KeyCode_C% ()
KeyCode_C% = 47
End Function
Function KeyCode_V% ()
KeyCode_V% = 48
End Function
Function KeyCode_B% ()
KeyCode_B% = 49
End Function
Function KeyCode_N% ()
KeyCode_N% = 50
End Function
Function KeyCode_M% ()
KeyCode_M% = 51
End Function
Function KeyCode_Comma% ()
KeyCode_Comma% = 52
End Function
Function KeyCode_Period% ()
KeyCode_Period% = 53
End Function
Function KeyCode_Slash% ()
KeyCode_Slash% = 54
End Function
Function KeyCode_ShiftRight% ()
KeyCode_ShiftRight% = 55
End Function
Function KeyCode_Up% ()
KeyCode_Up% = 329
End Function
Function KeyCode_Left% ()
KeyCode_Left% = 332
End Function
Function KeyCode_Down% ()
KeyCode_Down% = 337
End Function
Function KeyCode_Right% ()
KeyCode_Right% = 334
End Function
Function KeyCode_CtrlLeft% ()
KeyCode_CtrlLeft% = 30
End Function
Function KeyCode_WinLeft% ()
KeyCode_WinLeft% = 348
End Function
' _KEYHIT CODE NOT _BUTTON CODE
Function KeyCode_AltLeft% ()
KeyCode_AltLeft% = -30764
End Function
Function KeyCode_Spacebar% ()
KeyCode_Spacebar% = 58
End Function
' _KEYHIT CODE NOT _BUTTON CODE
Function KeyCode_AltRight% ()
KeyCode_AltRight% = -30765
End Function
Function KeyCode_WinRight% ()
KeyCode_WinRight% = 349
End Function
Function KeyCode_Menu% ()
KeyCode_Menu% = 350
End Function
Function KeyCode_CtrlRight% ()
KeyCode_CtrlRight% = 286
End Function
' ################################################################################################################################################################
' END KEYBOARD CODE FUNCTIONS
' ################################################################################################################################################################
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN DEBUGGING ROUTINES #DEBUGGING
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Sub DebugPrint (MyString As String)
If m_bDebug = TRUE Then
'_Echo MyString
ReDim arrLines(-1) As String
Dim iLoop As Integer
split MyString, Chr$(13), arrLines()
For iLoop = LBound(arrLines) To UBound(arrLines)
_Echo arrLines(iLoop)
Next iLoop
End If
End Sub ' DebugPrint
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END DEBUGGING ROUTINES @DEBUGGING
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ################################################################################################################################################################
' #REFERENCE
' =============================================================================
' SOME USEFUL STUFF FOR REFERENCE:
' Type Name Type suffix symbol Minimum value Maximum value Size in Bytes
' --------------------- ------------------ ---------------------------- -------------------------- -------------
' _BIT ` -1 0 1/8
' _BIT * n `n -128 127 n/8
' _UNSIGNED _BIT ~` 0 1 1/8
' _BYTE %% -128 127 1
' _UNSIGNED _BYTE ~%% 0 255 1
' INTEGER % -32,768 32,767 2
' _UNSIGNED INTEGER ~% 0 65,535 2
' LONG & -2,147,483,648 2,147,483,647 4
' _UNSIGNED LONG ~& 0 4,294,967,295 4
' _INTEGER64 && -9,223,372,036,854,775,808 9,223,372,036,854,775,807 8
' _UNSIGNED _INTEGER64 ~&& 0 18,446,744,073,709,551,615 8
' SINGLE ! or none -2.802597E-45 +3.402823E+38 4
' DOUBLE # -4.490656458412465E-324 +1.797693134862310E+308 8
' _FLOAT ## -1.18E-4932 +1.18E+4932 32(10 used)
' _OFFSET %& -9,223,372,036,854,775,808 9,223,372,036,854,775,807 Use LEN
' _UNSIGNED _OFFSET ~%& 0 18,446,744,073,709,551,615 Use LEN
' _MEM none combined memory variable type N/A Use LEN
' div: int1% = num1% \ den1%
' mod: rem1% = num1% MOD den1%
'#END
|
|
|
|
| What bone-head thing did I miss this time? |
|
Posted by: Pete - 10-28-2022, 05:11 PM - Forum: Help Me!
- Replies (12)
|
 |
Windows API for set window active should register a number in this little test routine, but it doesn't. I threw in a couple of other API functions that register just fine. Anyone know what I missed here?
Code: (Select All) DECLARE DYNAMIC LIBRARY "user32"
FUNCTION SetActiveWindow& (BYVAL hwnd AS LONG)
FUNCTION GetWindow& (BYVAL hwnd AS LONG, BYVAL nCmdShow AS LONG)
FUNCTION FindWindowA& (BYVAL ClassName AS LONG, WindowName$) 'handle by title
END DECLARE
title$ = "Set Window Active Test"
_TITLE (title$)
_DELAY .1
DO
hwnd& = FindWindowA(0, title$)
LOOP UNTIL hwnd&
DO
_LIMIT 10
c& = GetWindow(hwnd&, 1) ' Just put this in to show it does register.
a& = SetActiveWindow(hwnd&) ' This one should registere, but doesn't. <==============
PRINT "This should be non-zero:"; a&; " These are fine:"; c&, hwnd&
SLEEP 4
IF LEN(INKEY$) THEN END
LOOP
Pete
|
|
|
|
| ClipScribble |
|
Posted by: James D Jarvis - 10-28-2022, 03:51 PM - Forum: Works in Progress
- Replies (2)
|
|
A paint program with control panels in sperate windows. This uses the clipboard method to communicate between the different programs.
This piece of code is the color picker. The control has a simple slide bar for the red, green, and blue channels.
This will need to be saved and compiled as colorpickmix to be called by the clipscribble main program.
compile the main program and the control panels. Keep all the exe files in the same folder and it's a multi-window program in QB64. If you close a control panel by accident just manually open it again, it'll work fine.
colorpickmix
Code: (Select All) Screen _NewImage(240, 160, 32)
_ScreenMove 600, 50
_Title "colorpickmix"
'a color mixer that sends it's out put to the clipboard
rr = 127
gg = 127
bb = 127
rx = rr / 2 + 50
gx = gg / 2 + 50
bx = bb / 2 + 50
_PrintMode _KeepBackground
Line (10, 10)-(229, 40), _RGB32(rr, gg, bb), BF
_PrintString (1, 60), "[<]": _PrintString (215, 60), "[>]"
_PrintString (1, 90), "[<]": _PrintString (215, 90), "[>]"
_PrintString (1, 120), "[<]": _PrintString (215, 120), "[>]"
Do
_Limit 100
Do While _MouseInput 'mouse status changes only
x = _MouseX
y = _MouseY
If _MouseButton(1) Then
If y >= 59 And y <= 77 Then
If x <= rx + 8 Then rr = rr - 1 Else rr = rr + 1
If rr < 1 Then rr = 0
If rr > 255 Then rr = 255
End If
If y >= 89 And y <= 107 Then
If x <= gx + 8 Then gg = gg - 1 Else gg = gg + 1
If gg < 1 Then gg = 0
If gg > 255 Then gg = 255
End If
If y >= 119 And y <= 137 Then
If x <= bx + 8 Then bb = bb - 1 Else bb = bb + 1
If bb < 1 Then bb = 0
If bb > 255 Then bb = 255
End If
rt$ = packnum$(rr)
gt$ = packnum$(gg)
bt$ = packnum$(bb)
pp$ = "CMX" + rt$ + gt$ + bt$
_Clipboard$ = pp$
End If
Loop
rx = rr / 2 + 50
gx = gg / 2 + 50
bx = bb / 2 + 50
Line (50, 60)-(202, 76), _RGB32(rr, 0, 0), BF
_PrintString (rx, 60), _Trim$(Str$(rr))
Line (50, 90)-(202, 106), _RGB32(0, gg, 0), BF
_PrintString (gx, 90), _Trim$(Str$(gg))
Line (50, 120)-(202, 136), _RGB32(0, 0, bb), BF
_PrintString (bx, 120), _Trim$(Str$(bb))
Line (10, 10)-(229, 40), _RGB32(rr, gg, bb), BF
kk$ = InKey$
inx$ = _Clipboard$
If inx$ = "QUITCOLORMIX" Then kk$ = Chr$(27)
Loop Until kk$ = Chr$(27)
_Clipboard$ = "colorpickmix quit"
System
Function packnum$ (num)
pad$ = "000"
nn$ = _Trim$(Str$(num))
Select Case Len(nn$)
Case 1
Mid$(pad$, 3, 1) = nn$
Case 2
Mid$(pad$, 2, 2) = nn$
Case 3
pad$ = nn$
End Select
packnum$ = pad$
End Function
|
|
|
|
| MazeRogue |
|
Posted by: James D Jarvis - 10-28-2022, 12:12 AM - Forum: Works in Progress
- Replies (7)
|
|
A micro rogue-like game.
Navigate with arrow keys.
Collect gems, health potions, and power runes.
Monsters are just window dressing for now.
Code: (Select All) 'mazerogue
' a micro rogue by James D. Jarvis October 2022
'navigate with arrow keys
Screen _NewImage(81, 30, 0)
Randomize Timer
Dim T$
Dim crn$(4)
_ControlChr Off
_Scrolllock Off
Dim mz(0 To 80, 1 To 25) As String
Dim crnr(4, 2), loot(3), monst(3)
loot(1) = 4: loot(2) = 3: loot(3) = 15
monst(1) = 132: monst(2) = 42: monst(3) = 111
crnr(1, 1) = 1: crnr(1, 2) = 1
crnr(2, 1) = 79: crnr(2, 2) = 1
crnr(3, 1) = 1: crnr(3, 2) = 25
crnr(4, 1) = 79: crnr(4, 2) = 25
maxx = 80: maxy = 25: mlevel = 0
herox = Int(_Width / 2): heroy = Int(_Height / 2)
php = 10: ppow = 0: pgems = 0
newlevel:
mlevel = mlevel + 1
mlabel$ = "MazeRogue Level " + Str$(mlevel)
_Title mlabel$
For y = 1 To maxy
For x = 0 To maxx
mz(x, y) = Chr$(219)
Next
Next
nx = 3: ny = 3: done = 0
Do While done = 0
_Limit 1000
For reps = 0 To 99
ox = nx: oy = ny
Rem move in random direction
Select Case Int(Rnd * 4)
Case 0
If nx + 2 <= maxx Then nx = nx + 2
Case 1
If ny + 2 <= maxy Then ny = ny + 2
Case 2
If nx - 2 > 0 Then nx = nx - 2
Case 3
If ny - 2 > 0 Then ny = ny - 2
End Select
If mz(nx, ny) = Chr$(219) Then
mz(nx, ny) = ".": If 1 + Int(Rnd * 50) = 1 Then mz(nx, ny) = Chr$(loot(1 + Int(Rnd * 3)))
If mz(nx, ny) = "." And 1 + Int(Rnd * 50) <= mlevel Then mz(nx, ny) = Chr$(monst(1 + Int(Rnd * 3)))
mz(Int((nx + ox) / 2), ((ny + oy) / 2)) = "."
End If
Next
done = 1
For x = 1 To maxx - 1 Step 2
For y = 1 To maxy - 1 Step 2
If mz(x, y) = Chr$(219) Then done = 0
Next y
Next x
Loop
cr = 1 + Int(Rnd * 4) 'set a corner for the exit
If herox = crnr(cr, 1) And heroy = crnr(cr, 2) Then cr = 5 - cr
mz(crnr(cr, 1), crnr(cr, 2)) = Chr$(239)
T$ = "" 'load the maze into t$
For y = 1 To 25: For x = 0 To 80: T$ = T$ + mz$(x, y): Next x: Next y
ll$ = String$(81, 219) 'top and botton maze display edges becasue I didn't want to fix the maze generator to account for top and bottom edge
lastX = herox: lasty = heroy
Do 'game play loop
_Limit 20
Mid$(T$, (heroy) * 81 + herox - 81) = Chr$(1)
_PrintString (1, 1), ll$: _PrintString (1, 27), ll$: _PrintString (1, 2), T$
_PrintString (1, 28), String$(80, " ")
pcc$ = "Hit Points: " + Str$(php) + " Power: " + Str$(ppow) + " Gems: " + Str$(pgems)
_PrintString (3, 28), pcc$
If _KeyDown(19200) Then herox = herox - 1
If _KeyDown(19712) Then herox = herox + 1
If _KeyDown(18432) Then heroy = heroy - 1
If _KeyDown(20480) Then heroy = heroy + 1
If herox < 1 Then herox = 1
If herox > _Width Then herox = _Width
If heroy < 1 Then heroy = 1
If heroy > 25 Then heroy = 25
Mid$(T$, (lasty) * 81 + lastX - 81) = "."
If Mid$(T$, (heroy * 81 + herox - 81), 1) = Chr$(219) Then
herox = lastX: heroy = lasty
End If
For lp = 1 To 3
If Mid$(T$, (heroy * 81 + herox - 81), 1) = Chr$(loot(lp)) Then
Select Case lp
Case 1
pgems = pgems + 1
Case 2
php = php + 3
Case 3
ppow = ppow + 2
End Select
End If
Next lp
If Mid$(T$, (heroy * 81 + herox - 81), 1) = Chr$(239) Then
Beep: Cls: Print: Print "Continue to Next Level ?": Print: Input "Yes or No", ask$
If Left$(UCase$(ask$), 1) = "N" Then
heroy = lasty: herox = lastX
Else
Cls: GoTo newlevel
End If
End If
lastX = herox: lasty = heroy
k$ = InKey$
Loop Until k$ = Chr$(27)
System
|
|
|
|
| simple 2D vector graphics |
|
Posted by: madscijr - 10-27-2022, 07:45 PM - Forum: Works in Progress
- Replies (18)
|
|
I've been wanting to make a multiplayer Spacewar! type game, maybe with elements of Asteroids and other similar games, and what better way to learn than to look under the hood of a similar program and modify it? So I studied Terry Ritchie's "Widescreen Asteroids", which is very nicely done, but it turned out to be a lot more complicated than I have time and brain power for. However, Terry's game uses a simple method of defining vector objects line by line, so using that as a starting point, I have the beginning of a game.
So far all it does is draw some of the objects from Widescreen Asteroids and move them around the screen. Next is to figure out how to rotate them and translate the rotation angle into dx, dy to move in a given direction, and then figure out how to do collisions.
Anyway maybe this will help someone interested in learning about this... enjoy
Code: (Select All) _Title "Simple vector graphics v0.09 mostly by madscijr" ' display in the Window's title bar
' Simple test of vector graphics,
' borrowed graphics objects and format from Widescreen Asteroids by Terry Ritchie.
' TO DO:
' * rotate objects
' * translate rotation angle into dx,dy to move in direction of angle
' * speed up?
' * detect collisions
' BOOLEAN CONSTANTS
Const FALSE = 0
Const TRUE = Not FALSE
' HOLDS POSITION AND VELOCITY OF ALL OBJECTS
Type ObjectType
x As Integer
y As Integer
dx As Integer
dy As Integer
cx As Integer
cy As Integer
IsEnabled As Integer
End Type ' ObjectType
' HOLDS DEFINITION OF ALL OBJECTS
Type CoordType
x1 As Integer
y1 As Integer
x2 As Integer
y2 As Integer
color As _Unsigned Long
IsLast As Integer
End Type ' CoordType
' ENABLE / DISABLE DEBUG CONSOLE
Dim Shared m_bDebug As Integer: m_bDebug = TRUE
' BASIC PROGRAM METADATA
Dim Shared m_ProgramPath$: m_ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))
Dim Shared m_ProgramName$: m_ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)
' OBJECT VARIABLES
ReDim Shared m_arrObject(1 To 8) As ObjectType
ReDim Shared m_arrLines(1 To 8, 1 To 32) As CoordType
' ****************************************************************************************************************************************************************
' ACTIVATE DEBUGGING WINDOW
If m_bDebug = TRUE Then
$Console
_Delay 4
_Console On
_Echo "Started " + m_ProgramName$
_Echo "Debugging on..."
End If
' ****************************************************************************************************************************************************************
' =============================================================================
' START THE MAIN ROUTINE
main
' =============================================================================
' FINISH
Screen 0
Print m_ProgramName$ + " finished."
Input "Press <ENTER> to continue", in$
' ****************************************************************************************************************************************************************
' DEACTIVATE DEBUGGING WINDOW
If m_bDebug = TRUE Then
_Console Off
End If
' ****************************************************************************************************************************************************************
System ' return control to the operating system
End
' /////////////////////////////////////////////////////////////////////////////
Sub main
' LOCAL VARIABLES
Dim iFPS As Integer: iFPS = 120
Dim iLoop As Integer
Dim iObject As Integer
Dim iLine As Integer
Dim imgBack&
Dim imgMiddle&
Dim imgFront&
Dim iWhich As Integer: iWhich = 1
Dim bQuit As Integer: bQuit = FALSE
Dim in$
Dim sError As String: sError = ""
Dim iX As Integer
Dim iY As Integer
Dim sKey As String
Dim iMinX As Integer: iMinX = 0
Dim iMaxX As Integer: iMaxX = 800
Dim iMinY As Integer: iMinY = 0
Dim iMaxY As Integer: iMaxY = 640
' =============================================================================
' INITIALIZE
Screen _NewImage(800, 640, 32) ' 100 text columns x 40 text rows
'imgBack& = _NewImage(800, 640, 32) ' background
'imgMiddle& = _NewImage(800, 640, 32) ' other stuff
'imgFront& = _NewImage(800, 640, 32) ' foreground
' =============================================================================
' START NEW GAME
Do
_KeyClear
' CONFIGURE PRINTING FOR _PrintString
_PrintMode _FillBackground
'_PrintMode _KEEPBACKGROUND
' INIT VARS
sKey = ""
iX = 0: iY = 0
For iObject = LBound(m_arrObject) To UBound(m_arrObject)
m_arrObject(iObject).IsEnabled = FALSE
m_arrObject(iObject).x = iX
m_arrObject(iObject).y = iY
m_arrObject(iObject).dx = RandomNumber%(-5, 5)
m_arrObject(iObject).dy = RandomNumber%(-5, 5)
m_arrObject(iObject).cx = 0
m_arrObject(iObject).cy = 0
iX = iX + 200
If iX > 800 Then
iX = 0
iY = iY + 200
If iY > 640 Then
iY = 0
End If
End If
Next iObject
InitVectorObjects
' MAIN LOOP
While TRUE = TRUE
' REDRAW BACKGROUND LAYERS
DrawLayers imgBack&, imgMiddle&, imgFront&
'_Dest 0: Cls , cBlack
' SHOW TEXT
DrawText sKey, iWhich
' MOVE + DRAW ENABLED OBJECTS
For iObject = LBound(m_arrObject) To UBound(m_arrObject)
' Only enabled objects
If m_arrObject(iObject).IsEnabled = TRUE Then
' Move along X axis
m_arrObject(iObject).cx = m_arrObject(iObject).cx + 1
If m_arrObject(iObject).cx > (10 - Abs(m_arrObject(iObject).dx)) Then
m_arrObject(iObject).cx = 0
If m_arrObject(iObject).dx < 0 Then
m_arrObject(iObject).x = m_arrObject(iObject).x - 1
If m_arrObject(iObject).x < iMinX Then
m_arrObject(iObject).x = iMaxX
End If
ElseIf m_arrObject(iObject).dx > 0 Then
m_arrObject(iObject).x = m_arrObject(iObject).x + 1
If m_arrObject(iObject).x > iMaxX Then
m_arrObject(iObject).x = iMinX
End If
End If
End If
' Move along Y axis
m_arrObject(iObject).cy = m_arrObject(iObject).cy + 1
If m_arrObject(iObject).cy > (10 - Abs(m_arrObject(iObject).dy)) Then
m_arrObject(iObject).cy = 0
If m_arrObject(iObject).dy < 0 Then
m_arrObject(iObject).y = m_arrObject(iObject).y - 1
If m_arrObject(iObject).y < iMinY Then
m_arrObject(iObject).y = iMaxY
End If
ElseIf m_arrObject(iObject).dy > 0 Then
m_arrObject(iObject).y = m_arrObject(iObject).y + 1
If m_arrObject(iObject).y > iMaxY Then
m_arrObject(iObject).y = iMinY
End If
End If
End If
' Draw object's line segments
For iLine = LBound(m_arrLines, 2) To UBound(m_arrLines, 2)
'Line (x1%, y1%)-(x2%, y2%), arrColor(arrStars(iLoop).ColorIndex), BF
Line _
(m_arrObject(iObject).x + m_arrLines(iObject, iLine).x1, _
m_arrObject(iObject).y + m_arrLines(iObject, iLine).y1) _
- _
(m_arrObject(iObject).x + m_arrLines(iObject, iLine).x2, _
m_arrObject(iObject).y + m_arrLines(iObject, iLine).y2) _
, _
m_arrLines(iObject, iLine).color ' , BF
If m_arrLines(iObject, iLine).IsLast = TRUE Then
Exit For
End If
Next iLine
End If
Next iObject
' UPDATE THE SCREEN
_Display
' PROCESS INPUT
While _DeviceInput(1): Wend ' clear and update the keyboard buffer
sKey = ""
' QUIT?
If _Button(KeyCode_Escape%) Then
bQuit = TRUE
Exit While
End If
' OTHER INPUT 1-6 SELECTS WHICH OBJECT TO CHANGE
If _Button(KeyCode_1%) Then
sKey = sKey + "1,"
iWhich = 1
ElseIf _Button(KeyCode_2%) Then
sKey = sKey + "2,"
iWhich = 2
ElseIf _Button(KeyCode_3%) Then
sKey = sKey + "3,"
iWhich = 3
ElseIf _Button(KeyCode_4%) Then
sKey = sKey + "4,"
iWhich = 4
ElseIf _Button(KeyCode_5%) Then
sKey = sKey + "5,"
iWhich = 5
ElseIf _Button(KeyCode_6%) Then
sKey = sKey + "6,"
iWhich = 6
End If
' GET DIRECTION
If _Button(KeyCode_Left%) Then
sKey = sKey + "LEFT,"
m_arrObject(iWhich).dx = m_arrObject(iWhich).dx - 1
If m_arrObject(iWhich).dx < -10 Then m_arrObject(iWhich).dx = -10
ElseIf _Button(KeyCode_Right%) Then
sKey = sKey + "RIGHT,"
m_arrObject(iWhich).dx = m_arrObject(iWhich).dx + 1
If m_arrObject(iWhich).dx > 10 Then m_arrObject(iWhich).dx = 10
ElseIf _Button(KeyCode_Up%) Then
sKey = sKey + "UP,"
m_arrObject(iWhich).dy = m_arrObject(iWhich).dy - 1
If m_arrObject(iWhich).dy < -10 Then m_arrObject(iWhich).dy = -10
ElseIf _Button(KeyCode_Down%) Then
sKey = sKey + "DOWN,"
m_arrObject(iWhich).dy = m_arrObject(iWhich).dy + 1
If m_arrObject(iWhich).dy > 10 Then m_arrObject(iWhich).dy = 10
End If
' CLEAR KEYBOARD BUFFER
_KeyClear
' CONTROL GAME SPEED
_Limit iFPS
Wend
' UPDATE THE SCREEN
_Display
' CLEAR KEYBOARD BUFFER
_KeyClear: _Delay 2
' PLAY ANOTHER ROUND OR QUIT?
If bQuit = FALSE Then
If bExit = FALSE Then Sleep
Color cWhite, cBlack
Else
Exit Do
End If
Loop
' RETURN TO AUTODISPLAY
_AutoDisplay
End Sub ' main
' /////////////////////////////////////////////////////////////////////////////
' VECTOR OBJECT DEFINITIONS
Sub InitVectorObjects
Dim iLoop As Integer
Dim iObject As Integer
Dim iLine As Integer
Dim x1 As Integer
Dim y1 As Integer
Dim x2 As Integer
Dim y2 As Integer
Dim r1 As Integer
Dim g1 As Integer
Dim b1 As Integer
iObject = 1
iLine = 1
Restore VectorData
For iLoop = 1 To 1024
Read x1
Read y1
Read x2
Read y2
Read r1
Read g1
Read b1 ' -255 means no more data, -254 means last set for this object
If b1 = -255 Then
m_arrLines(iObject, iLine).IsLast = TRUE
m_arrObject(iObject).IsEnabled = TRUE
Exit For
ElseIf b1 = -254 Then
m_arrLines(iObject, iLine).IsLast = TRUE
m_arrObject(iObject).IsEnabled = TRUE
iObject = iObject + 1
iLine = 1
If iObject > UBound(m_arrLines, 1) Then Exit For
Else
m_arrLines(iObject, iLine).x1 = x1
m_arrLines(iObject, iLine).y1 = y1
m_arrLines(iObject, iLine).x2 = x2
m_arrLines(iObject, iLine).y2 = y2
m_arrLines(iObject, iLine).color = _RGB32(r1, g1, b1)
m_arrLines(iObject, iLine).IsLast = FALSE
iLine = iLine + 1
If iLine > UBound(m_arrLines, 2) Then Exit For
End If
Next iLoop%
VectorData:
'objaster1 = purple
Data 2,-41,31,-50,128,0,255
Data 31,-50,56,-23,128,0,255
Data 56,-23,37,-10,128,0,255
Data 37,-10,61,13,128,0,255
Data 61,13,32,62,128,0,255
Data 32,62,-22,43,128,0,255
Data -22,43,-40,57,128,0,255
Data -40,57,-62,34,128,0,255
Data -62,34,-47,7,128,0,255
Data -47,7,-62,-26,128,0,255
Data -62,-26,-32,-63,128,0,255
Data -32,-63,2,-41,128,0,255
Data 0,0,0,0,-254,-254,-254
'objaster2 = red
Data -28,-62,22,-62,255,0,0
Data 22,-62,61,-28,255,0,0
Data 61,-28,61,13,255,0,0
Data 61,13,23,57,255,0,0
Data 23,57,-6,62,255,0,0
Data -6,62,-6,15,255,0,0
Data -6,15,-36,47,255,0,0
Data -36,47,-59,14,255,0,0
Data -59,14,-35,1,255,0,0
Data -35,1,-62,-9,255,0,0
Data -62,-9,-28,-62,255,0,0
Data 0,0,0,0,-254,-254,-254
'objaster3 = orange
Data 9,-62,60,-21,255,165,0
Data 60,-21,62,-3,255,165,0
Data 62,-3,24,13,255,165,0
Data 24,13,53,34,255,165,0
Data 53,34,38,55,255,165,0
Data 38,55,20,40,255,165,0
Data 20,40,-37,61,255,165,0
Data -37,61,-63,15,255,165,0
Data -63,15,-57,-24,255,165,0
Data -57,-24,-24,-24,255,165,0
Data -24,-24,-38,-45,255,165,0
Data -38,-45,9,-62,255,165,0
Data 0,0,0,0,-254,-254,-254
'objmouse = yellow
Data 0,-10,6,3,255,255,0
Data 6,3,1,2,255,255,0
Data 1,2,1,10,255,255,0
Data 1,10,-1,10,255,255,0
Data -1,10,-1,2,255,255,0
Data -1,2,-6,3,255,255,0
Data -6,3,0,-10,255,255,0
Data 0,0,0,0,-254,-254,-254
'objship = cyan
Data 0,-15,10,15,0,255,255
Data 10,15,6,11,0,255,255
Data 6,11,-6,11,0,255,255
Data -6,11,-10,15,0,255,255
Data -10,15,0,-15,0,255,255
Data 0,0,0,0,-254,-254,-254
'Data 0,18,0,18,0,255,255
'Data 0,0,0,0,-254,-254,-254
'objufo = green
Data -4,-16,4,-16,0,255,0
Data 4,-16,10,-6,0,255,0
Data 10,-6,25,5,0,255,0
Data 25,5,10,16,0,255,0
Data 10,16,-10,16,0,255,0
Data -10,16,-25,5,0,255,0
Data -25,5,-10,-6,0,255,0
Data -10,-6,-4,-16,0,255,0
Data -10,-6,10,-6,0,255,0
Data -25,5,25,5,0,255,0
Data 0,0,0,0,-255,-255,-255
End Sub ' InitVectorObjects
' /////////////////////////////////////////////////////////////////////////////
' (RE)DRAW SCREEN
Sub DrawLayers (imgBack&, imgMiddle&, imgFront&)
_Dest 0
Cls , cBlack
If TRUE = FALSE Then
If imgBack& < -1 Then
_PutImage , imgBack&, 0
End If
If imgMiddle& < -1 Then
_PutImage , imgMiddle&, 0
End If
If imgFront& < -1 Then
_PutImage , imgFront&, 0
End If
End If
End Sub ' DrawLayers
' /////////////////////////////////////////////////////////////////////////////
' SHOW INSTRUMENTS + INSTRUCTIONS
' 800x600 = 40 rows x 100 columns
sub DrawText( _
sKey as string, _
iWhich as integer _
)
Dim iObject As Integer
Dim iX As Integer
Dim iY As Integer
Color cWhite
PrintAt 1, 1, "Simple 2D vector graphics test"
Color cYellow
PrintAt 3, 1, "Press 1-6 to select active object."
PrintAt 4, 1, "Arrow keys move active object."
iY = 6
For iObject = LBound(m_arrObject) To UBound(m_arrObject)
If m_arrObject(iObject).IsEnabled = TRUE Then
Color cCyan
Else
Color cGray
End If
PrintAt iY, 1, "" + _
"obj #" + cstr$(iObject) + _
"(" + cstr$(m_arrObject(iObject).x) + "," + cstr$(m_arrObject(iObject).y) + ")" + _
"(" + cstr$(m_arrObject(iObject).dx) + "," + cstr$(m_arrObject(iObject).dy) + ")" + _
"(" + cstr$(m_arrObject(iObject).cx) + "," + cstr$(m_arrObject(iObject).cy) + ")" + _
""
iY = iY + 1
Next iObject
' SHOW INPUT
'if m_bDebug=TRUE then
Color cLime
PrintAt 20, 1, "Controls : " + RightPadString$(sKey, 10, " ") + " "
Color cWhite
PrintAt 21, 1, "Object # : " + cstr$(iWhich)
'end if
' SHOW COORDINATES
End Sub ' DrawText
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GENERAL PURPOSE FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' /////////////////////////////////////////////////////////////////////////////
Function cstr$ (myValue)
'cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
cstr$ = _Trim$(Str$(myValue))
End Function ' cstr$
' /////////////////////////////////////////////////////////////////////////////
' Hack function, to be replaced with something better
Function DblToInt% (dblOld As Double)
Dim dblNew As Double
Dim sValue As String
Dim iPos As Integer
dblNew = RoundDouble#(dblOld, 0)
'sValue = _Trim$(Str$(dblNew))
sValue = DblToStr$(dblNew)
'iPos = InStr(1, sValue, ".")
'If iPos > 0 Then
' DblToInt% = Val(Left$(sValue, iPos - 1))
'Else
' DblToInt% = Val(sValue)
'End If
DblToInt% = Val(sValue)
End Function ' DblToInt%
' /////////////////////////////////////////////////////////////////////////////
' Scientific notation - QB64 Wiki
' https://www.qb64.org/wiki/Scientific_notation
' Example: A string function that displays extremely small or large exponential decimal values.
Function DblToStr$ (n#)
Dim result$: result$ = ""
Dim value$
Dim Xpos%
Dim expo%
Dim sign$
Dim valu$
Dim dot%
Dim L%
Dim add$
Dim min$
Dim DP$
Dim n%
value$ = UCase$(LTrim$(Str$(n#)))
Xpos% = InStr(value$, "D") + InStr(value$, "E") ' only D or E can be present
If Xpos% Then
expo% = Val(Mid$(value$, Xpos% + 1))
If Val(value$) < 0 Then
sign$ = "-"
valu$ = Mid$(value$, 2, Xpos% - 2)
Else
valu$ = Mid$(value$, 1, Xpos% - 1)
End If
dot% = InStr(valu$, ".")
L% = Len(valu$)
If expo% > 0 Then
add$ = String$(expo% - (L% - dot%), "0")
End If
If expo% < 0 Then
min$ = String$(Abs(expo%) - (dot% - 1), "0")
DP$ = "."
End If
For n% = 1 To L%
If Mid$(valu$, n%, 1) <> "." Then
num$ = num$ + Mid$(valu$, n%, 1)
End If
Next n%
result$ = _Trim$(sign$ + DP$ + min$ + num$ + add$)
Else
result$ = value$
End If
DblToStr$ = result$
End Function ' DblToStr$
' /////////////////////////////////////////////////////////////////////////////
Function DblRoundedToStr$ (dblValue As Double, intNumPlaces As Integer)
Dim dblNew As Double
dblNew = RoundDouble#(dblValue, intNumPlaces)
DblRoundedToStr$ = DblToStr$(dblNew)
End Function ' DblRoundedToStr$
' /////////////////////////////////////////////////////////////////////////////
Function DoubleABS# (dblValue As Double)
If Sgn(dblValue) = -1 Then
DoubleABS# = 0 - dblValue
Else
DoubleABS# = dblValue
End If
End Function ' DoubleABS#
' /////////////////////////////////////////////////////////////////////////////
' Scientific notation - QB64 Wiki
' https://www.qb64.org/wiki/Scientific_notation
' Example: A string function that displays extremely small or large exponential decimal values.
Function FloatToStr$ (n##)
value$ = UCase$(LTrim$(Str$(n##)))
Xpos% = InStr(value$, "D") + InStr(value$, "E") 'only D or E can be present
If Xpos% Then
expo% = Val(Mid$(value$, Xpos% + 1))
If Val(value$) < 0 Then
sign$ = "-"
valu$ = Mid$(value$, 2, Xpos% - 2)
Else
valu$ = Mid$(value$, 1, Xpos% - 1)
End If
dot% = InStr(valu$, ".")
L% = Len(valu$)
If expo% > 0 Then
add$ = String$(expo% - (L% - dot%), "0")
End If
If expo% < 0 Then
min$ = String$(Abs(expo%) - (dot% - 1), "0")
DP$ = "."
End If
For n = 1 To L%
If Mid$(valu$, n, 1) <> "." Then
num$ = num$ + Mid$(valu$, n, 1)
End If
Next n
Else
FloatToStr$ = value$
Exit Function
End If
FloatToStr$ = _Trim$(sign$ + DP$ + min$ + num$ + add$)
End Function ' FloatToStr$
' /////////////////////////////////////////////////////////////////////////////
' By sMcNeill from https://www.qb64.org/forum/index.php?topic=896.0
Function IsNum% (text$)
Dim a$
Dim b$
a$ = _Trim$(text$)
b$ = _Trim$(Str$(Val(text$)))
If a$ = b$ Then
IsNum% = TRUE
Else
IsNum% = FALSE
End If
End Function ' IsNum%
' /////////////////////////////////////////////////////////////////////////////
' Split and join strings
' https://www.qb64.org/forum/index.php?topic=1073.0
'Combine all elements of in$() into a single string with delimiter$ separating the elements.
Function join$ (in$(), delimiter$)
Dim result$
Dim i As Long
result$ = in$(LBound(in$))
For i = LBound(in$) + 1 To UBound(in$)
result$ = result$ + delimiter$ + in$(i)
Next i
join$ = result$
End Function ' join$
' /////////////////////////////////////////////////////////////////////////////
Function LeftPadString$ (myString$, toWidth%, padChar$)
LeftPadString$ = Right$(String$(toWidth%, padChar$) + myString$, toWidth%)
End Function ' LeftPadString$
' /////////////////////////////////////////////////////////////////////////////
' ABS was returning strange values with type LONG
' so I created this which does not.
Function LongABS& (lngValue As Long)
If Sgn(lngValue) = -1 Then
LongABS& = 0 - lngValue
Else
LongABS& = lngValue
End If
End Function ' LongABS&
' /////////////////////////////////////////////////////////////////////////////
' iRow% and iCol% are 0-based in this version
Sub PrintAt (iRow%, iCol%, sText$)
'_PrintString (iCol% * 8, iRow% * 16), sText$
_PrintString (iCol% * 8, iRow% * 16), sText$
'_PrintString (iCol%, iRow%), sText$
End Sub ' PrintAt
' /////////////////////////////////////////////////////////////////////////////
' Generate random value between Min and Max.
Function RandomNumber% (Min%, Max%)
Dim NumSpread%
' SET RANDOM SEED
'Randomize ' Initialize random-number generator.
Randomize Timer
' GET RANDOM # Min%-Max%
'RandomNumber = Int((Max * Rnd) + Min) ' generate number
NumSpread% = (Max% - Min%) + 1
RandomNumber% = Int(Rnd * NumSpread%) + Min% ' GET RANDOM # BETWEEN Max% AND Min%
End Function ' RandomNumber%
' /////////////////////////////////////////////////////////////////////////////
Function RightPadString$ (myString$, toWidth%, padChar$)
RightPadString$ = Left$(myString$ + String$(toWidth%, padChar$), toWidth%)
End Function ' RightPadString$
' /////////////////////////////////////////////////////////////////////////////
' https://www.qb64.org/forum/index.php?topic=3605.0
' Quote from: SMcNeill on Today at 03:53:48 PM
'
' Sometimes, you guys make things entirely too complicated.
' There ya go! Three functions to either round naturally,
' always round down, or always round up, to whatever number of digits you desire.
' EDIT: Modified to add another option to round scientific,
' since you had it's description included in your example.
' Receives + returns _FLOAT myVar## (-1.18E-4932 to +1.18E+4932)
' =============================================================================
' ROUNDING FUNCTIONS FOR TYPE _FLOAT
Function Round## (num##, digits%)
Round## = Int(num## * 10 ^ digits% + .5) / 10 ^ digits%
End Function
Function RoundUp## (num##, digits%)
RoundUp## = _Ceil(num## * 10 ^ digits%) / 10 ^ digits%
End Function
Function RoundDown## (num##, digits%)
RoundDown## = Int(num## * 10 ^ digits%) / 10 ^ digits%
End Function
Function RoundScientific## (num##, digits%)
RoundScientific## = _Round(num## * 10 ^ digits%) / 10 ^ digits%
End Function
' =============================================================================
' ROUNDING FUNCTIONS FOR TYPE DOUBLE
Function RoundDouble# (num#, digits%)
RoundDouble# = Int(num# * 10 ^ digits% + .5) / 10 ^ digits%
End Function
Function RoundUpDouble# (num#, digits%)
RoundUpDouble# = _Ceil(num# * 10 ^ digits%) / 10 ^ digits%
End Function
Function RoundDownDouble# (num#, digits%)
RoundDownDouble# = Int(num# * 10 ^ digits%) / 10 ^ digits%
End Function
Function RoundScientificDouble# (num#, digits%)
RoundScientificDouble# = _Round(num# * 10 ^ digits%) / 10 ^ digits%
End Function
' /////////////////////////////////////////////////////////////////////////////
Function SmallestOf3% (i1%, i2%, i3%)
Dim iMin%
iMin% = i1%
If i2% < iMin% Then iMin% = i2%
If i3% < iMin% Then iMin% = i3%
SmallestOf3% = iMin%
End Function ' SmallestOf3
' /////////////////////////////////////////////////////////////////////////////
' Split and join strings
' https://www.qb64.org/forum/index.php?topic=1073.0
'
' FROM luke, QB64 Developer
' Date: February 15, 2019, 04:11:07 AM
'
' Given a string of words separated by spaces (or any other character),
' splits it into an array of the words. I've no doubt many people have
' written a version of this over the years and no doubt there's a million
' ways to do it, but I thought I'd put mine here so we have at least one
' version. There's also a join function that does the opposite
' array -> single string.
'
' Code is hopefully reasonably self explanatory with comments and a little demo.
' Note, this is akin to Python/JavaScript split/join, PHP explode/implode.
'Split in$ into pieces, chopping at every occurrence of delimiter$. Multiple consecutive occurrences
'of delimiter$ are treated as a single instance. The chopped pieces are stored in result$().
'
'delimiter$ must be one character long.
'result$() must have been REDIMmed previously.
' Modified to handle multi-character delimiters
Sub split (in$, delimiter$, result$())
Dim start As Integer
Dim finish As Integer
Dim iDelimLen As Integer
ReDim result$(-1)
iDelimLen = Len(delimiter$)
start = 1
Do
'While Mid$(in$, start, 1) = delimiter$
While Mid$(in$, start, iDelimLen) = delimiter$
'start = start + 1
start = start + iDelimLen
If start > Len(in$) Then
Exit Sub
End If
Wend
finish = InStr(start, in$, delimiter$)
If finish = 0 Then
finish = Len(in$) + 1
End If
ReDim _Preserve result$(0 To UBound(result$) + 1)
result$(UBound(result$)) = Mid$(in$, start, finish - start)
start = finish + 1
Loop While start <= Len(in$)
End Sub ' split
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GENERAL PURPOSE FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN COLOR FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Function cRed~& ()
cRed = _RGB32(255, 0, 0)
End Function
Function cOrangeRed~& ()
cOrangeRed = _RGB32(255, 69, 0)
End Function ' cOrangeRed~&
Function cDarkOrange~& ()
cDarkOrange = _RGB32(255, 140, 0)
End Function ' cDarkOrange~&
Function cOrange~& ()
cOrange = _RGB32(255, 165, 0)
End Function ' cOrange~&
Function cGold~& ()
cGold = _RGB32(255, 215, 0)
End Function ' cGold~&
Function cYellow~& ()
cYellow = _RGB32(255, 255, 0)
End Function ' cYellow~&
' LONG-HAIRED FRIENDS OF JESUS OR NOT,
' THIS IS NOT YELLOW ENOUGH (TOO CLOSE TO LIME)
' TO USE FOR OUR COMPLEX RAINBOW SEQUENCE:
Function cChartreuse~& ()
cChartreuse = _RGB32(127, 255, 0)
End Function ' cChartreuse~&
' WE SUBSTITUTE THIS CSS3 COLOR FOR INBETWEEN LIME AND YELLOW:
Function cOliveDrab1~& ()
cOliveDrab1 = _RGB32(192, 255, 62)
End Function ' cOliveDrab1~&
Function cLime~& ()
cLime = _RGB32(0, 255, 0)
End Function ' cLime~&
Function cMediumSpringGreen~& ()
cMediumSpringGreen = _RGB32(0, 250, 154)
End Function ' cMediumSpringGreen~&
' ADDED THIS FOR THE GAUGE COLOR:
Function cSpringGreen~& ()
cSpringGreen = _RGB32(0, 255, 160)
End Function ' cSpringGreen~&
Function cCyan~& ()
cCyan = _RGB32(0, 255, 255)
End Function ' cCyan~&
Function cDeepSkyBlue~& ()
cDeepSkyBlue = _RGB32(0, 191, 255)
End Function ' cDeepSkyBlue~&
Function cDodgerBlue~& ()
cDodgerBlue = _RGB32(30, 144, 255)
End Function ' cDodgerBlue~&
Function cSeaBlue~& ()
cSeaBlue = _RGB32(0, 64, 255)
End Function ' cSeaBlue~&
Function cBlue~& ()
cBlue = _RGB32(0, 0, 255)
End Function ' cBlue~&
Function cBluePurple~& ()
cBluePurple = _RGB32(64, 0, 255)
End Function ' cBluePurple~&
Function cDeepPurple~& ()
cDeepPurple = _RGB32(96, 0, 255)
End Function ' cDeepPurple~&
Function cPurple~& ()
cPurple = _RGB32(128, 0, 255)
End Function ' cPurple~&
Function cPurpleRed~& ()
cPurpleRed = _RGB32(128, 0, 192)
End Function ' cPurpleRed~&
Function cDarkRed~& ()
cDarkRed = _RGB32(160, 0, 64)
End Function ' cDarkRed~&
Function cBrickRed~& ()
cBrickRed = _RGB32(192, 0, 32)
End Function ' cBrickRed~&
Function cDarkGreen~& ()
cDarkGreen = _RGB32(0, 100, 0)
End Function ' cDarkGreen~&
Function cGreen~& ()
cGreen = _RGB32(0, 128, 0)
End Function ' cGreen~&
Function cOliveDrab~& ()
cOliveDrab = _RGB32(107, 142, 35)
End Function ' cOliveDrab~&
Function cLightPink~& ()
cLightPink = _RGB32(255, 182, 193)
End Function ' cLightPink~&
Function cHotPink~& ()
cHotPink = _RGB32(255, 105, 180)
End Function ' cHotPink~&
Function cDeepPink~& ()
cDeepPink = _RGB32(255, 20, 147)
End Function ' cDeepPink~&
Function cMagenta~& ()
cMagenta = _RGB32(255, 0, 255)
End Function ' cMagenta~&
Function cBlack~& ()
cBlack = _RGB32(0, 0, 0)
End Function ' cBlack~&
Function cDimGray~& ()
cDimGray = _RGB32(105, 105, 105)
End Function ' cDimGray~&
Function cGray~& ()
cGray = _RGB32(128, 128, 128)
End Function ' cGray~&
Function cDarkGray~& ()
cDarkGray = _RGB32(169, 169, 169)
End Function ' cDarkGray~&
Function cSilver~& ()
cSilver = _RGB32(192, 192, 192)
End Function ' cSilver~&
Function cLightGray~& ()
cLightGray = _RGB32(211, 211, 211)
End Function ' cLightGray~&
Function cGainsboro~& ()
cGainsboro = _RGB32(220, 220, 220)
End Function ' cGainsboro~&
Function cWhiteSmoke~& ()
cWhiteSmoke = _RGB32(245, 245, 245)
End Function ' cWhiteSmoke~&
Function cWhite~& ()
cWhite = _RGB32(255, 255, 255)
'cWhite = _RGB32(254, 254, 254)
End Function ' cWhite~&
Function cDarkBrown~& ()
cDarkBrown = _RGB32(128, 64, 0)
End Function ' cDarkBrown~&
Function cLightBrown~& ()
cLightBrown = _RGB32(196, 96, 0)
End Function ' cLightBrown~&
Function cKhaki~& ()
cKhaki = _RGB32(240, 230, 140)
End Function ' cKhaki~&
Function cEmpty~& ()
'cEmpty~& = -1
cEmpty = _RGB32(0, 0, 0, 0)
End Function ' cEmpty~&
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END COLOR FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ################################################################################################################################################################
' BEGIN KEYBOARD CODE FUNCTIONS
' NOTE: ALL CODES ARE FOR _BUTTON, EXCEPT:
' cF10 (_KEYDOWN)
' cAltLeft (_KEYHIT)
' cAltRight (_KEYHIT)
' cPrintScreen (_KEYHIT) <- may slow down pc?
' cPauseBreak (_KEYHIT) <- may not work?
' ################################################################################################################################################################
Function KeyCode_Escape% ()
KeyCode_Escape% = 2
End Function
Function KeyCode_F1% ()
KeyCode_F1% = 60
End Function
Function KeyCode_F2% ()
KeyCode_F2% = 61
End Function
Function KeyCode_F3% ()
KeyCode_F3% = 62
End Function
Function KeyCode_F4% ()
KeyCode_F4% = 63
End Function
Function KeyCode_F5% ()
KeyCode_F5% = 64
End Function
Function KeyCode_F6% ()
KeyCode_F6% = 65
End Function
Function KeyCode_F7% ()
KeyCode_F7% = 66
End Function
Function KeyCode_F8% ()
KeyCode_F8% = 67
End Function
Function KeyCode_F9% ()
KeyCode_F9% = 68
End Function
'_KEYDOWN CODE, NOT _BUTTON CODE
Function KeyCode_F10% ()
KeyCode_F10% = 17408
End Function
Function KeyCode_F11% ()
KeyCode_F11% = 88
End Function
Function KeyCode_F12% ()
KeyCode_F12% = 89
End Function
'_KEYHIT CODE, NOT _BUTTON CODE
Function KeyCode_PrintScreen% ()
KeyCode_PrintScreen% = -44
End Function
Function KeyCode_ScrollLock% ()
KeyCode_ScrollLock% = 71
End Function
'_KEYHIT CODE, NOT _BUTTON CODE
Function KeyCode_PauseBreak% ()
KeyCode_PauseBreak% = 31053
End Function
Function KeyCode_Tilde% ()
KeyCode_Tilde% = 42
End Function
Function KeyCode_1% ()
KeyCode_1% = 3
End Function
Function KeyCode_2% ()
KeyCode_2% = 4
End Function
Function KeyCode_3% ()
KeyCode_3% = 5
End Function
Function KeyCode_4% ()
KeyCode_4% = 6
End Function
Function KeyCode_5% ()
KeyCode_5% = 7
End Function
Function KeyCode_6% ()
KeyCode_6% = 8
End Function
Function KeyCode_7% ()
KeyCode_7% = 9
End Function
Function KeyCode_8% ()
KeyCode_8% = 10
End Function
Function KeyCode_9% ()
KeyCode_9% = 11
End Function
Function KeyCode_0% ()
KeyCode_0% = 12
End Function
Function KeyCode_Minus% ()
KeyCode_Minus% = 13
End Function
Function KeyCode_Equal% ()
KeyCode_Equal% = 14
End Function
Function KeyCode_BkSp% ()
KeyCode_BkSp% = 15
End Function
Function KeyCode_Ins% ()
KeyCode_Ins% = 339
End Function
Function KeyCode_Home% ()
KeyCode_Home% = 328
End Function
Function KeyCode_PgUp% ()
KeyCode_PgUp% = 330
End Function
Function KeyCode_Del% ()
KeyCode_Del% = 340
End Function
Function KeyCode_End% ()
KeyCode_End% = 336
End Function
Function KeyCode_PgDn% ()
KeyCode_PgDn% = 338
End Function
Function KeyCode_NumLock% ()
KeyCode_NumLock% = 326
End Function
Function KeyCode_KeypadSlash% ()
KeyCode_KeypadSlash% = 310
End Function
Function KeyCode_KeypadMultiply% ()
KeyCode_KeypadMultiply% = 56
End Function
Function KeyCode_KeypadMinus% ()
KeyCode_KeypadMinus% = 75
End Function
Function KeyCode_Keypad7Home% ()
KeyCode_Keypad7Home% = 72
End Function
Function KeyCode_Keypad8Up% ()
KeyCode_Keypad8Up% = 73
End Function
Function KeyCode_Keypad9PgUp% ()
KeyCode_Keypad9PgUp% = 74
End Function
Function KeyCode_KeypadPlus% ()
KeyCode_KeypadPlus% = 79
End Function
Function KeyCode_Keypad4Left% ()
KeyCode_Keypad4Left% = 76
End Function
Function KeyCode_Keypad5% ()
KeyCode_Keypad5% = 77
End Function
Function KeyCode_Keypad6Right% ()
KeyCode_Keypad6Right% = 78
End Function
Function KeyCode_Keypad1End% ()
KeyCode_Keypad1End% = 80
End Function
Function KeyCode_Keypad2Down% ()
KeyCode_Keypad2Down% = 81
End Function
Function KeyCode_Keypad3PgDn% ()
KeyCode_Keypad3PgDn% = 82
End Function
Function KeyCode_KeypadEnter% ()
KeyCode_KeypadEnter% = 285
End Function
Function KeyCode_Keypad0Ins% ()
KeyCode_Keypad0Ins% = 83
End Function
Function KeyCode_KeypadPeriodDel% ()
KeyCode_KeypadPeriodDel% = 84
End Function
Function KeyCode_Tab% ()
KeyCode_Tab% = 16
End Function
Function KeyCode_Q% ()
KeyCode_Q% = 17
End Function
Function KeyCode_W% ()
KeyCode_W% = 18
End Function
Function KeyCode_E% ()
KeyCode_E% = 19
End Function
Function KeyCode_R% ()
KeyCode_R% = 20
End Function
Function KeyCode_T% ()
KeyCode_T% = 21
End Function
Function KeyCode_Y% ()
KeyCode_Y% = 22
End Function
Function KeyCode_U% ()
KeyCode_U% = 23
End Function
Function KeyCode_I% ()
KeyCode_I% = 24
End Function
Function KeyCode_O% ()
KeyCode_O% = 25
End Function
Function KeyCode_P% ()
KeyCode_P% = 26
End Function
Function KeyCode_BracketLeft% ()
KeyCode_BracketLeft% = 27
End Function
Function KeyCode_BracketRight% ()
KeyCode_BracketRight% = 28
End Function
Function KeyCode_Backslash% ()
KeyCode_Backslash% = 44
End Function
Function KeyCode_CapsLock% ()
KeyCode_CapsLock% = 59
End Function
Function KeyCode_A% ()
KeyCode_A% = 31
End Function
Function KeyCode_S% ()
KeyCode_S% = 32
End Function
Function KeyCode_D% ()
KeyCode_D% = 33
End Function
Function KeyCode_F% ()
KeyCode_F% = 34
End Function
Function KeyCode_G% ()
KeyCode_G% = 35
End Function
Function KeyCode_H% ()
KeyCode_H% = 36
End Function
Function KeyCode_J% ()
KeyCode_J% = 37
End Function
Function KeyCode_K% ()
KeyCode_K% = 38
End Function
Function KeyCode_L% ()
KeyCode_L% = 39
End Function
Function KeyCode_Semicolon% ()
KeyCode_Semicolon% = 40
End Function
Function KeyCode_Apostrophe% ()
KeyCode_Apostrophe% = 41
End Function
Function KeyCode_Enter% ()
KeyCode_Enter% = 29
End Function
Function KeyCode_ShiftLeft% ()
KeyCode_ShiftLeft% = 43
End Function
Function KeyCode_Z% ()
KeyCode_Z% = 45
End Function
Function KeyCode_X% ()
KeyCode_X% = 46
End Function
Function KeyCode_C% ()
KeyCode_C% = 47
End Function
Function KeyCode_V% ()
KeyCode_V% = 48
End Function
Function KeyCode_B% ()
KeyCode_B% = 49
End Function
Function KeyCode_N% ()
KeyCode_N% = 50
End Function
Function KeyCode_M% ()
KeyCode_M% = 51
End Function
Function KeyCode_Comma% ()
KeyCode_Comma% = 52
End Function
Function KeyCode_Period% ()
KeyCode_Period% = 53
End Function
Function KeyCode_Slash% ()
KeyCode_Slash% = 54
End Function
Function KeyCode_ShiftRight% ()
KeyCode_ShiftRight% = 55
End Function
Function KeyCode_Up% ()
KeyCode_Up% = 329
End Function
Function KeyCode_Left% ()
KeyCode_Left% = 332
End Function
Function KeyCode_Down% ()
KeyCode_Down% = 337
End Function
Function KeyCode_Right% ()
KeyCode_Right% = 334
End Function
Function KeyCode_CtrlLeft% ()
KeyCode_CtrlLeft% = 30
End Function
Function KeyCode_WinLeft% ()
KeyCode_WinLeft% = 348
End Function
' _KEYHIT CODE NOT _BUTTON CODE
Function KeyCode_AltLeft% ()
KeyCode_AltLeft% = -30764
End Function
Function KeyCode_Spacebar% ()
KeyCode_Spacebar% = 58
End Function
' _KEYHIT CODE NOT _BUTTON CODE
Function KeyCode_AltRight% ()
KeyCode_AltRight% = -30765
End Function
Function KeyCode_WinRight% ()
KeyCode_WinRight% = 349
End Function
Function KeyCode_Menu% ()
KeyCode_Menu% = 350
End Function
Function KeyCode_CtrlRight% ()
KeyCode_CtrlRight% = 286
End Function
' ################################################################################################################################################################
' END KEYBOARD CODE FUNCTIONS
' ################################################################################################################################################################
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN DEBUGGING ROUTINES #DEBUGGING
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Sub DebugPrint (MyString As String)
If m_bDebug = TRUE Then
'_Echo MyString
ReDim arrLines(-1) As String
Dim iLoop As Integer
split MyString, Chr$(13), arrLines()
For iLoop = LBound(arrLines) To UBound(arrLines)
_Echo arrLines(iLoop)
Next iLoop
End If
End Sub ' DebugPrint
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END DEBUGGING ROUTINES @DEBUGGING
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ################################################################################################################################################################
' #REFERENCE
' =============================================================================
' SOME USEFUL STUFF FOR REFERENCE:
' Type Name Type suffix symbol Minimum value Maximum value Size in Bytes
' --------------------- ------------------ ---------------------------- -------------------------- -------------
' _BIT ` -1 0 1/8
' _BIT * n `n -128 127 n/8
' _UNSIGNED _BIT ~` 0 1 1/8
' _BYTE %% -128 127 1
' _UNSIGNED _BYTE ~%% 0 255 1
' INTEGER % -32,768 32,767 2
' _UNSIGNED INTEGER ~% 0 65,535 2
' LONG & -2,147,483,648 2,147,483,647 4
' _UNSIGNED LONG ~& 0 4,294,967,295 4
' _INTEGER64 && -9,223,372,036,854,775,808 9,223,372,036,854,775,807 8
' _UNSIGNED _INTEGER64 ~&& 0 18,446,744,073,709,551,615 8
' SINGLE ! or none -2.802597E-45 +3.402823E+38 4
' DOUBLE # -4.490656458412465E-324 +1.797693134862310E+308 8
' _FLOAT ## -1.18E-4932 +1.18E+4932 32(10 used)
' _OFFSET %& -9,223,372,036,854,775,808 9,223,372,036,854,775,807 Use LEN
' _UNSIGNED _OFFSET ~%& 0 18,446,744,073,709,551,615 Use LEN
' _MEM none combined memory variable type N/A Use LEN
' div: int1% = num1% \ den1%
' mod: rem1% = num1% MOD den1%
|
|
|
|
|
