BASIC Gaming

How To Program A Game With QB64 - Lesson #1

Written by Lachie Dazdarian (June, 2012)

Introduction

This is a QB64 version of the beginner-level game making tutorial in two parts I originally wrote for FB (BASIC Gaming issue #1 and #2). The changes made in the tutorial only reflect the small differences in the compilers and their graphics commands, but the topics and the examples remain the same.

The objective of this series of lessons is to help newbies who know very little of BASIC to learn the basics of programming in QB64 necessary to create any 2D computer game. Some elementary BASIC knowledge would help a lot, though I believe that people who don't know BASIC at all should comprehend these lessons too. I'm using here the word (well, it's an acronym) "BASIC", because if you know the basics of QuickBASIC, Visual BASIC or any other variant of BASIC, these lessons should be easy to comprehend.

My goal with this series is to learn you enough so you would be self-sufficient in 90% of cases in 2D game design. And the best way to learn new things is to see them applied. Many tutorials fail in this by being too generic. You will always need help from more proficient programmers, but the point is that after these series you won't need it on every step. Have in mind that this depends on the type of game you are developing and the graphics library / tools you are using.

I am definitely not going to make you a good programmer or show you how to become one with these tutorials. Forget about it. I will only teach you enough to be able to make a 2D game. The rest is up to you. You might ask me then why you shouldn't pick some game making software instead picking QB64 and reading these tutorials. Well, because learing to program leaves you so much more space to build and expand on your basic knowledge and in the end makes you much more flexible when it comes to solving game design problems.

This tutorial will not deal with raycasting engines (3D programming) or something "advanced" like that. If you want that but are a beginner, you NEED the following lessons FIRST.

Since we are going to code in QB64 you need to get QB64 first (if you don't have it yet) from http://www.qb64.net. I also recommend Dav's QB64 IDE for the programming environment. Dowload it here: http://www.qbasicnews.com/dav/projects.php

QB64 was imagined as a continuation of QBasic on modern operating systems. So despite the fact you can compile QBasic programs in it and go on by only using QBasic commands, to make the full benefit of 32-bit operating systems, it is beneficial to learn the new QB64 commands.

Example #1: A simple program - The circle moves!

We'll start with some elementary stuff. The first program we'll code will not feature external graphics, because loading graphics from external files (usually BMP images) is always a dirty business and will confuse you at this point. Trust me on this. Be patient.

The program we'll create will allow you to move a circle around the screen. A very simple program, but through making it we'll learn important facts and a lot of elementary statements and methods necessary to create any game.

Start DavsIDE. First thing we'll do is set the graphics mode. What's setting a graphics mode? Choosing the program's graphics resolution and color depth in bits (8-bit, 32-bit, ...). For example, 8-bit color depth is the standard 256 colors mode (8 bits per pixel). The graphics mode is set with the SCREEN and _NEWIMAGE statements like this:

SCREEN _NEWIMAGE(640, 480, 256)

First parameter sets the screen width, second screen height, and third color depth (256 - 256 colors, 32 - 32-bit color depth -> 16 million colors). For the last parameter you can use numbers from 0-2 and 7-13 to emulate old QBasic Legacy screen modes. Check out BASIC Gaming #6 for OlDosLover's tutorial on QB64 Screen Modes for more info on this topic.

The next thing we'll do is set a loop that plays until the user pushes the letter Q on the keyboard. Loops are foundation of any interactive program, not just a computer game. Coding a program on a way it would stop/halt every now and then and wait for the user to type something in is a BAD and WRONG way to program anything you want for other people to play. We'll use loops as places where the program waits for the user to do something (clicks with mouse or pushes a key) and where the program executes some routine according to user's action. It will also be used as a place where objects not controlled by the player (enemies) are managed/moved. Loops are a must have.

If you are aware of all these things, you can skip to the end of this section and download the completed example (with comments). If there is something in it you don't understand, then get back here.

We can setup a loop on more ways (with WHILE:WEND statements, using the GOTO statement - Noooo!), but the best way in my opinion is to use DO...LOOP. This type of loop simply repeats a block of statements in it until the condition is met. You set the condition(s) after LOOP with UNTIL. You can also use WHILE instead of UNTIL to make the loop run WHILE some variable is of certain value, which can use useful in some applications. But from my experience, for game loops UNTIL is usually more common. Check the following code:

SCREEN _NEWIMAGE(640, 480, 256)  ' Sets the graphic mode
DO
' We'll put our statemens here later
LOOP UNTIL INKEY$ = "Q" or INKEY$ = "q"

If you compile this code and run it, you'll get a small black empty 640*480 window which you can turn off by pushing the letter Q (you might need to hold it). The program simply loops until you press "Q or "q". I used both upper and lower case "Q" symbol in case Caps Lock is turned on on your keyboard. INKEY$ is a statement that returns the last key pushed on the keyboard. I will explain later why it shouldn't be used with games and what's a better substitute in QB64.

To draw a circle we'll use the CIRCLE statement. Check the following code:

SCREEN _NEWIMAGE(640, 480, 256) ' Sets the graphic mode

DO

CIRCLE (150, 90), 10, 15 

LOOP UNTIL INKEY$ = "Q" or INKEY$ = "q"

The last code draws a small circle on coordinates 150, 90 with a radius of 10 and color 15 (plain white) in a loop, which you can check if you compile the code. So how to move that circle? We need to connect its coordinates with VARIABLES. For this we'll use two variables named circlex and circley. Check the following code:

DIM SHARED circlex AS SINGLE, circley AS SINGLE

SCREEN _NEWIMAGE(640, 480, 256) ' Sets the graphic mode

circlex = 150 ' Initial circle position
circley = 90

DO

CIRCLE (circlex, circley), 10, 15 

LOOP UNTIL INKEY$ = "Q" or INKEY$ = "q"

This makes no change in the result of our program, but it's a step to what we want to accomplish. You can change the amounts to which circlex and circley equal to change the circle's initial position, but that's not what we really want. In order to move the circle we need to connect circlex and circley variables with keyboard statements. If we don't assign values to our variables they will be 0 by default.

We declared first two variables in our program above with:

DIM [SHARED] variable_name1 AS [type_of_variable] , variable_name2 AS [type_of_variable]

Variables can be INTEGER, LONG, SINGLE, DOUBLE, STRING and also _BIT, _BYTE, _INTEGER64 and _FLOAT. Refer to QB64 WIKI for more details on variable declarations. QB64 does not require from you to declare variables, but those important in the program that you will use all over the code, I recommend that you declare them. You can also set variable type by using a suffix, so instead typing in "AS SINGLE", we could have used suffix "!". Like this:

DIM SHARED circlex!, circley!

SCREEN _NEWIMAGE(640, 480, 256) ' Sets the graphic mode

circlex! = 150 ' Initial circle position
circley! = 90

DO

CIRCLE (circlex!, circley!), 10, 15 

LOOP UNTIL INKEY$ = "Q" or INKEY$ = "q"

If you want for all variables starting with a certain letter to be a specific variable type by default, you need to place at the begining of your program DEF + "variable type shorthand". Like DEFINT A-C makes all undeclared variables starting with A, B or C to be INTEGERS.

What you need to know at this point is that you should declare variables or arrays AS INTEGER (suffix "%") when they represent data which doesn't need decimal precision (number of lives, points, etc.). Variables that need decimal precision are declared AS SINGLE (suffix "!") or DOUBLE (suffix "#"). Those are usually variables used in games which rely on physics formulae like arcade car driving games or jump 'n run games (gravity effect). Simply, the difference between the speed of two pixels per cycle and the speed of one pixel per cycle is most often too large, and in those limits you can't emulate effects like fluid movement on the most satisfactory way. Also, behind DIM you put SHARED which makes that the specific variable readable in the entire program (all subroutines). Don't use SHARED only with variables declared inside subroutines. If you are going to declare ARRAYS inside a subroutine, I advise you to replace DIM with REDIM. Strings are used to hold text data. Like YourName = "Dodo", but you need to declare YourName AS STRING first or just use it with "$" suffix.

Certain programmers shun global variables (declared with SHARED) and consider them a bad programming habbit. I strongly disagree with their sentiment, but you should just be aware that many don't agree with strong usage of shared variables. In my opinion and years of experience, using SHARED variables is rarely if ever a cause of bugs or crashes.

Now I will introduce a new statement instead of INKEY$ which can detect multiple keypresses and is much more responsive than INKEY$. The flaw of INKEY$, as well as being very non-responsive (which you probably were able to detect when trying to shut down the previously compiled examples), is that it can detect only one keypress at any given moment which renders it completely unusable in games.

The substitute we'll use is _KEYDOWN (QB64 only command) which features only one parameter and that's the ASCII Keyboard Code of the key you want to query. You might be lost now. ASCII Keyboard Code is nothing but a code referred by the computer to a certain keyboard key. The keyboard scancodes are available on this page: http://qb64.net/wiki/index.php?title=KEYDOWN

You can use the values from the _KEYDOWN Keyboard Values table or convert them to HEX numbers as I prefer. Not sure if there are benefits to this, neverthless, it's what I prefer. Use _KEYDOWN like this:

_KEYDOWN(&H....)

Instead of dots you input the HEX number. As I said, you can use the values from the table without conversion. For example, for up arrow key:

_KEYDOWN(18432)

Is the same as:

_KEYDOWN(&H4800)

Now the fun starts.

We will add a new variable named circlespeed which flags (sets) how many pixels the circle will move in one cycle (loop). The movement will be done with the arrows key. Every time the user pushes a certain arrow key we will tell the program to change either circlex or circley (depends on the pushed key) by the amount of circlespeed. Check the following code:

DIM SHARED circlex AS SINGLE , circley AS SINGLE , circlespeed AS SINGLE  

SCREEN _NEWIMAGE(640, 480, 256) ' Sets the graphic mode

circlex = 150   ' Initial circle position
circley = 90
circlespeed = 1.5 ' Circle's speed => 1 pixel per loop

DO

CIRCLE (circlex, circley), 10, 15

' According to pushed key we change the circle's coordinates.
IF _KEYDOWN(&H4D00) THEN circlex = circlex + circlespeed
IF _KEYDOWN(&H4B00) THEN circlex = circlex - circlespeed
IF _KEYDOWN(&H5000) THEN circley = circley + circlespeed
IF _KEYDOWN(&H4800) THEN circley = circley - circlespeed

LOOP UNTIL _KEYDOWN(&H71) OR _KEYDOWN(&H1B)

For readability we can replace the keyboard codes with constants, like this:

' Keyboard constants
CONST KEYDOWN& = &H5000
CONST KEYUP& = &H4800
CONST KEYLEFT& = &H4B00
CONST KEYRIGHT& = &H4D00
CONST KEYq& = &H71
CONST KEYESCAPE& = &H1B

DIM SHARED circlex AS SINGLE , circley AS SINGLE , circlespeed AS SINGLE  

SCREEN _NEWIMAGE(640, 480, 256) ' Sets the graphic mode

circlex = 150   ' Initial circle position
circley = 90
circlespeed = 1.5 ' Circle's speed => 1 pixel per loop

DO

CIRCLE (circlex, circley), 10, 15

' According to pushed key we change the circle's coordinates.
IF _KEYDOWN(KEYRIGHT&) THEN circlex = circlex + circlespeed
IF _KEYDOWN(KEYLEFT&) THEN circlex = circlex - circlespeed
IF _KEYDOWN(KEYDOWN&) THEN circley = circley + circlespeed
IF _KEYDOWN(KEYUP&) THEN circley = circley - circlespeed

LOOP UNTIL _KEYDOWN(KEYq&) OR _KEYDOWN(KEYESCAPE&)

As you see we also changed the condition after UNTIL since we are using _KEYDOWN now. Now you can exit the program by pressing ESCAPE too (I added one more condition).

If you compile the last version of the code, two things we don't want to happen will happen. The program will run so fast you won't even notice the movement of the circle, and the circle will "smear" the screen (the circles drawn on different coordinates in previous cycles will remain on the screen). To avoid smearing you need to have the CLS statement (clears the screen) in the loop so that in every new cycle the old circle from the previous cycle is erased before the new is drawn.

To reduce the speed of the program the quickest fix is the _LIMIT statement. The _LIMIT statement sets the loop repeat rate of a program to so many per second, relinquishing spare cpu cycles to other applications. We'll also use the _DISPLAY statement after all the drawing to prevent flicker. The _DISPLAY statement turns off automatic display while only displaying the screen changes when called.

Copy and paste the following code and compile it:

' Keyboard constants
CONST KEYDOWN& = &H5000
CONST KEYUP& = &H4800
CONST KEYLEFT& = &H4B00
CONST KEYRIGHT& = &H4D00
CONST KEYq& = &H71
CONST KEYESCAPE& = &H1B

DIM SHARED circlex AS SINGLE , circley AS SINGLE , circlespeed AS SINGLE  

SCREEN _NEWIMAGE(640, 480, 256) ' Sets the graphic mode

circlex = 150   ' Initial circle position
circley = 90
circlespeed = 1.5 ' Circle's speed => 1 pixel per loop

DO

_LIMIT 60 ' limit FPS to 60
CLS ' clear the screen

CIRCLE (circlex, circley), 10, 15

_DISPLAY

' According to pushed key we change the circle's coordinates.
IF _KEYDOWN(KEYRIGHT&) THEN circlex = circlex + circlespeed
IF _KEYDOWN(KEYLEFT&) THEN circlex = circlex - circlespeed
IF _KEYDOWN(KEYDOWN&) THEN circley = circley + circlespeed
IF _KEYDOWN(KEYUP&) THEN circley = circley - circlespeed

LOOP UNTIL _KEYDOWN(KEYq&) OR _KEYDOWN(KEYESCAPE&)

Viola! Our circle is moving and "slow enough".

The last version of the code does not represent the desirable way of coding, but I had to simplify the code in order to make this lesson easy to understand. What we need to do next is declare our variables on the way they should be declared in any "serious" program.

The way variables are declared in the above code is not the most convenient approach in larger projects where we have huge amount of variables usually associated to several objects (an object can be the player, enemy or anything that is defined with MORE THAN ONE variable).

So first we'll define a user defined data type with the statement TYPE that can contain more variables/arrays (stay with me). We'll name this user data type ObjectType. The code:

TYPE ObjectType
     x AS SINGLE
     y AS SINGLE
     speed AS SINGLE
END TYPE

After this we declare our circle as an object:

DIM SHARED CircleM AS ObjectType
' We can't declare this variable with "Circle"
' since then QB64 can't differ it from 
' the statement CIRCLE, thus "CircleM".

How is this approach beneficial? It allows us to manage the program variables on a more efficient and cleaner way. Instead of (in this example) having to declare each circle's characteristic (it's position, speed, etc.) separately, we'll simply use a type:def that includes all these variables and associate a variable or an array to it (in this case that's CircleM). So now the circle's x position is flagged with CircleM.X, circle's y position with CircleM.Y and circle's speed with CircleM.speed. I hope you see how this is better. One user defined type can be connected with more variables or arrays. In this example you can add another object with something like DIM SHARED EnemyCircle(8) AS ObjectType which would allow us to manage 8 "evil" circles with a specific set of routines (an AI of some sort) using the variables from the ObjectType type:def (x, y, speed), and these circles could "attack" the user's circle on some way. In the next lesson all this will become more clear. Have in mind that not ALL variables need to be declared using a type:def. This is only for "objects" in your game that are defined (characterized) with more variables (like a hero determined by health, money, score, strength, etc.). Or think about it on this way:

Type Person
  Name as string
  Sex as Integer
  Age as integer
  Height as Single
  Weight as Single
End Type

'Make a gang of 10 persons
Dim People(1 to 10) as Person

' Assign values to first two persons
People(1).Name = "Pete"
People(1).Sex = 1
People(1).Age = 25
People(1).Height = 185
People(1).Weight = 75
People(2).Name = "Helen"
People(2).Sex = 2
People(2).Age = 29
People(2).Height = 175
People(2).Weight = 65

Maybe that example is more illustrative.

After this change the final version of the code looks like this:

' Keyboard constants
CONST KEYDOWN& = &H5000
CONST KEYUP& = &H4800
CONST KEYLEFT& = &H4B00
CONST KEYRIGHT& = &H4D00
CONST KEYq& = &H71
CONST KEYESCAPE& = &H1B

' Our user defined type.
TYPE ObjectType
     x AS SINGLE
     y AS SINGLE
     speed AS SINGLE
END TYPE

DIM SHARED CircleM AS ObjectType
' We can't declare this variable with "Circle"
' since then QB64 can't differ it from 
' the statement CIRCLE, thus "CircleM".

SCREEN _NEWIMAGE(640, 480, 256) ' Sets the graphic mode

CircleM.x = 150   ' Initial circle position
CircleM.y = 90
CircleM.speed = 1 ' Circle's speed => 1 pixel per loop
_MOUSEHIDE ' hide the mouse cursor

DO

_LIMIT 60 ' limit FPS to 60
CLS ' clear the screen

CIRCLE (CircleM.x, CircleM.y), 10, 15

_DISPLAY

' According to pushed key we change the circle's coordinates.
IF _KEYDOWN(KEYRIGHT&) THEN CircleM.x = CircleM.x + CircleM.speed
IF _KEYDOWN(KEYLEFT&) THEN CircleM.x = CircleM.x - CircleM.speed
IF _KEYDOWN(KEYDOWN&) THEN CircleM.y = CircleM.y + CircleM.speed
IF _KEYDOWN(KEYUP&) THEN CircleM.y = CircleM.y - CircleM.speed

LOOP UNTIL _KEYDOWN(KEYq&) OR _KEYDOWN(KEYESCAPE&)

You will notice I added one more statement in the code. The _MOUSEHIDE statement hides the mouse cursor. I'll deal with other mouse statement later.

Download the completed example: move_circle.zip

Phew, we are done with the first example. Some of you might think I went into too many details, but I feel all this dance was needed to make the next examples and lessons a more enjoyable adventure.

Nevertheless, this example is far from what we want, right? So the next chapter will learn you how to load graphics from external files among other things.

Example #2: A warrior running around a green field

In the next example we will be applying all the knowledge from the first example, so don't expect for this example to go into every statement again. I will explain every new statement and just brush off the old ones.

In this section we'll start to code our mini-game which won't be completed in this lesson. In this lesson we'll just create a program where a warrior runs around a green field (single screen).

First I'll show you what graphics we'll be using. We are going to work in 8-bit color depth mode, so the images that we are going to use need to be saved in that mode (256 colors mode). For warrior sprites I'll use the sprites of the main character from my first QB game Dark Quest.

As you see this image features 12 sprites of our warrior, each 40*40 pixels large. Two for each direction (walk animation) and one sprite for each direction when the warrior is swinging with his sword. Sword swinging won’t be implemented in the first lesson, but will become necessary later.

Second image is the background image which you can check/download if you click here (640*480 pixels large, 8-bit BMP image).

Download both images and place them where you will place the source, or just download the completed example at the end of this section.

Let's go:

' Keyboard constants
CONST KEYDOWN& = &H5000
CONST KEYUP& = &H4800
CONST KEYLEFT& = &H4B00
CONST KEYRIGHT& = &H4D00
CONST KEYq& = &H71
CONST KEYESCAPE& = &H1B
' Other constants
CONST TRUE = 1
CONST FALSE = 0

SCREEN _NEWIMAGE(640, 480, 256) ' Sets the graphic mode
_MOUSEHIDE ' hide the mouse cursor

Notice that I added two more constants, TRUE and FALSE. They are very beneficial since we can use words TRUE and FALSE to flag and change the status of variables that should only be one of these two states. Instead of using 1 and 0 we use more recognizable terms TRUE and FALSE. This is only for readability.

Now we will declare (dimension) 2 LONG variables that will store our graphics.

The first we'll name background1 and declare it with the following line:

DIM SHARED background1 AS LONG

The next variable (memory buffer) we'll declare will store the sprites:

DIM SHARED WarriorSprites AS LONG

To load images into these memory buffers we'll use _LOADIMAGE statement like in the code that follows:

' Keyboard constants
CONST KEYDOWN& = &H5000
CONST KEYUP& = &H4800
CONST KEYLEFT& = &H4B00
CONST KEYRIGHT& = &H4D00
CONST KEYq& = &H71
CONST KEYESCAPE& = &H1B
' Other constants
CONST TRUE = 1
CONST FALSE = 0

DIM SHARED background1 AS LONG
DIM SHARED WarriorSprites AS LONG

SCREEN _NEWIMAGE(640, 480, 256) ' Sets the graphic mode
_MOUSEHIDE ' hide the mouse cursor

background1 = _LOADIMAGE("BACKGRND.bmp")
_COPYPALETTE background1, 0
WarriorSprites = _LOADIMAGE("SPRITES.bmp")

The _COPYPALETTE statement copies the color palette intensities from one 4 or 8 BPP image to another image or a _NEWIMAGE screen page using 256 or less colors. We used 0 here as the second parameter so we copied the palette of the loaded image onto screen.

We are done with loading graphics. Now we will declare additional variables needed in this example. I'll define a data type like in the previous example, but it will contain more variables. The following code should be placed before the variable declarations.

TYPE ObjectType
	X          AS SINGLE
	Y          AS SINGLE
	Speed      AS SINGLE
	Frame      AS INTEGER
	Direction  AS INTEGER
	Move       AS INTEGER
	Attack     AS INTEGER
	Alive      AS INTEGER
END TYPE

The object that will be used to control the warrior is declared with:

DIM SHARED Player AS ObjectType

Frame variable will be used to flag the sprite that needs to be displayed (according to warrior's direction, if he is moving or not, etc.). Direction will be used to flag the warrior's direction, Move if he is moving or not, Attack if he is attacking or not (so we could flag the proper sprite), and Alive if he is alive or not (not used in this example, but most often necessary).

Let's set a loop on the way it's done in the previous example:

DO

_LIMIT 60 ' limit FPS to 60
CLS ' clear the screen

_DISPLAY

LOOP UNTIL _KEYDOWN(KEYq&) OR _KEYDOWN(KEYESCAPE&)

To display graphics we'll use QB64 only command _PUTIMAGE. The _PUTIMAGE statement puts an area of a source image to an area of a destination image in one operation like GET and PUT.

Syntax:

_PUTIMAGE [(dx1, dy1)[-(dx2, dy2)]][, source_handle][, dest_handle][, (sx1, sy1)[-(sx2, sy2)]]
or…
_PUTIMAGE 'full source image to fit full destination area after _SOURCE and _DEST are set
_PUTIMAGE , source_handle, dest_handle 'size full source to fit full destination area
_PUTIMAGE (dx1, dy1), source_handle, dest_handle 'full source to TL corner destination position
_PUTIMAGE (dx1, dy1)-(dx2, dy2), source_handle, dest_handle 'size full source to destination coordinate area
_PUTIMAGE (dx1, dy1), source_handle,dest_handle, (sx1, sy1)-(sx2, sy2) 'portion of source to TL corner of destination
_PUTIMAGE , source_handle, dest_handle, (sx1, sy1)-(sx2, sy2) 'portion of source to full destination area
_PUTIMAGE (dx1, dy1)-(dx2, dy2), source_handle, dest_handle,(sx1, sy1) 'right side of source from TL corner to destination

So _PUTIMAGE can be used to strech or shrinken the image if dx2 and dy2 are used, for example. But to simply display the sprite on destination position on the screen we'll use:

_PUTIMAGE (dx1, dy1), source_handle, 0

Let's add the background to our program:

DO

_LIMIT 60 ' limit FPS to 60

_PUTIMAGE (0,0), background1, 0 ' paste background on 0,0 on the screen (last paremeter)

_DISPLAY

LOOP UNTIL _KEYDOWN(KEYq&) OR _KEYDOWN(KEYESCAPE&)

Since we are pasting graphics over the entire screen, it is not needed to use CLS anymore. The background image deletes all the content on the screen from the previous loop. Let's now add the player sprite on the screen. As you might have noticed, in the WarriorSprites memory buffer we stored ALL the sprites. How do we display only one then? Well, using _PUTIMAGE's sx1, sy1, sx2 and sy2 parameters, which are used only to display a part of the source image.

If we examine the sprites sheet we will see that frames for walking down are on positions 1 and 2, for up 3 and 4, for left 5 and 6, and for right 7 and 8. We'll also notice that sprites are 40 pixels wide and 40 pixels high.

Observe the following code:

' Keyboard constants
CONST KEYDOWN& = &H5000
CONST KEYUP& = &H4800
CONST KEYLEFT& = &H4B00
CONST KEYRIGHT& = &H4D00
CONST KEYq& = &H71
CONST KEYESCAPE& = &H1B
' Other constants
CONST TRUE = 1
CONST FALSE = 0

TYPE ObjectType
	X          AS SINGLE
	Y          AS SINGLE
	Speed      AS SINGLE
	Frame      AS INTEGER
	Direction  AS INTEGER
	Move       AS INTEGER
	Attack     AS INTEGER
	Alive      AS INTEGER
END TYPE

DIM SHARED background1 AS LONG
DIM SHARED WarriorSprites AS LONG

DIM SHARED Player AS ObjectType

Player.X = 100 ' Starting player's position and frame
Player.Y = 100
Player.Frame = 1

SCREEN _NEWIMAGE(640, 480, 256) ' Sets the graphic mode
_MOUSEHIDE ' hide the mouse cursor

background1 = _LOADIMAGE("BACKGRND.bmp", 256)
_COPYPALETTE background1, 0
WarriorSprites = _LOADIMAGE("SPRITES.bmp")
_CLEARCOLOR 0, WarriorSprites

DO

_LIMIT 60 ' limit FPS to 60
CLS ' clear the screen

_PUTIMAGE (0,0), background1, 0 ' paste background on 0,0 on the screen (last paremeter)

_PUTIMAGE (Player.X, Player.Y), WarriorSprites, 0, ((Player.Frame-1)*40, 0)-(39+(Player.Frame-1)*40, 39)

_DISPLAY

LOOP UNTIL _KEYDOWN(KEYq&) OR _KEYDOWN(KEYESCAPE&)

Notice I used the _CLEARCOLOR statement. It sets the transparent color of the desired image handle, in this case it was color 0 (black) of our sprites sheet. Compile the code and a sprite of warrior will appear on the screen. If you play with the Player.Frame variable you'll be able to display different frames. Now, how does the _PUTIMAGE statement work for the player sprites? It's actually rather simple. All you need to do is to connect the source coordinates inside _PUTIMAGE with the Frame variable in order to display different sprites according to the value of the Frame variable. For example, if Frame equals 3, _PUTIMAGE will display this piece of WarriorSprites: ((3-1)*40, 0)-(39+(3-1)*40,39) => (80,0)-(119,39). If you check these coordinates in an image editor, you'll see that 3rd sprite starts from and ends on those coordinates. Simple! The way your formula connecting sprite frames or tile numbers will look like will depend on the size of your sprites/tiles and how they are aligned in the sprite/tilesheet, how many rows and columns it features, etc. You might want to check Terry Richies's Sprite Lib (http://www.qb64.net/forum/index.php?topic=4141.0) or Unseen's GDK library (lib, tutorial) for libraries that do that for you. Still, I think _PUTIMAGE is easy enough to use that with some minimum effort you should be able create your own sprites/tiles loading/pasting routines.

Let's now implement moving for the player:

DO

_LIMIT 60 ' limit FPS to 60
CLS ' clear the screen

' Player.Direction = 1 -> warrior moving right
' Player.Direction = 2 -> warrior moving left
' Player.Direction = 3 -> warrior moving down
' Player.Direction = 4 -> warrior moving up

Player.Move = FALSE ' By deafult the player is not
                    ' moving.
                    
' According to pushed key move the
' player and flag the proper direction.
IF _KEYDOWN(KEYRIGHT&) THEN 
    Player.X = Player.X + Player.Speed
    Player.Direction = 1
    Player.Move = TRUE
END IF
IF _KEYDOWN(KEYLEFT&) THEN 
    Player.X = Player.X - Player.Speed
    Player.Direction = 2
    Player.Move = TRUE
END IF
IF _KEYDOWN(KEYDOWN&) THEN 
    Player.Y = Player.Y + Player.Speed
    Player.Direction = 3
    Player.Move = TRUE
END IF
IF _KEYDOWN(KEYUP&) THEN 
    Player.Y = Player.Y - Player.Speed
    Player.Direction = 4
    Player.Move = TRUE
END IF

' According to player's direction flag the 
' proper sprite (check in the tutorial on which
' position each sprite is stored).
IF Player.Direction = 1 THEN Player.Frame = 6 + 1
IF Player.Direction = 2 THEN Player.Frame = 4 + 1
IF Player.Direction = 3 THEN Player.Frame = 0 + 1
IF Player.Direction = 4 THEN Player.Frame = 2 + 1

_PUTIMAGE (0,0), background1, 0 ' paste background on 0,0 on the screen (last paremeter)

_PUTIMAGE (Player.X, Player.Y), WarriorSprites, 0, ((Player.Frame-1)*40, 0)-(39+(Player.Frame-1)*40, 39)

_DISPLAY

LOOP UNTIL _KEYDOWN(KEYq&) OR _KEYDOWN(KEYESCAPE&)

The new code should be self-explanatory for the most part. We have 4 IF clauses and each one flags a specific move according to pushed key. For example, if the player pushed RIGHT arrow key, player's X position is increased by player's speed, proper direction is flagged and we also flag that movement is happening (will be used later to animate the player). According to flagged direction a proper frame is set. If you compile the code with these additions you will be able to move the warrior, but it will slide on the grass. How to implement animation? We'll use a variable that will cycle from 1 to 2. Let's name that variable Frame1 and declare it AS INTEGER. This is how you cycle it:

Frame1 = (Frame1 MOD 2) + 1
IF Player.Move = FALSE OR Frame1 = 0 THEN Frame1 = 1 ' this only prevents Frame1 to be 0

Be sure to declare Frame1 (together with other variable declarations) with DIM SHARED Frame1 AS INTEGER.

The line Frame1 = (Frame1 MOD 2) + 1 is a substitute for:

Frame1 = Frame1 + 1
IF Frame1 > 2 THEN Frame1 = 1

MOD finds the remainder from a division operation. So Frame1 MOD 2 results with the remainder when we divide Frame1 with 2. If Frame1 is 1, divided by 2 it results with the remainder of 0.5, which is rounded on 1. If you add 1 to 1, you get 2. If Frame1 is 2, divided by 2 it results with the remainder of 0. If you add 0 to 1, you get 1. So with Frame1 = (Frame1 MOD 2) + 1 we loop from 1 to 2, adding one unit in each cycle.

All you need to know is that this formula changes variable Frame1 by 1 in each cycle from number 1 to the number specified after MOD. If you would want for Frame1 to loop from 50 to 66 you would need to input Frame1 = (Frame1 MOD 16) + 50, but that's not what we need. We need a variable that toggles from 1 to 2 in each cycle to enable walk animation. To make this work we need to change the 4 lines of code that set the player's frame:

IF Player.Direction = 1 THEN Player.Frame = 6 + Frame1
IF Player.Direction = 2 THEN Player.Frame = 4 + Frame1
IF Player.Direction = 3 THEN Player.Frame = 0 + Frame1
IF Player.Direction = 4 THEN Player.Frame = 2 + Frame1

So when Frame1 equals 1 and the player is moving right (Player.Direction = 1) Player.Frame equals 7, while when Frame1 equals 2 Player.Frame equals 8. Check the lesson on the place where I specified on which position each sprite is stored in the WarriorSprites array. You'll see that "moving right" sprites are stored on positions 7 and 8. Now why we need that condition where the Player.Move variable is used? When the player is not moving Frame1 needs to be 1 or 2 IN EVERY CYCLE (no sprite rotation). Second condition (IF Frame1 = 0) is there to prevent errors (when the loop starts Frame1 might equal 0 and the program might load a sprite out of bounds or something; I highly advise this sort of precaution measure).

If you compile the code again with these changes, you'll notice that warrior's legs are moving too fast. How to set the speed of sprite rotation? You need another variable like Frame1 (we'll name it Frame2) that will grow to a higher number and connect it with Frame1. This results in Frame1 not changing in every cycle, but only when Frame2 equals a certain number. Check the following code:

Frame2 = (Frame2 MOD 12) + 1
IF Frame2 = 10 THEN Frame1 = (Frame1 MOD 2) + 1

Now Frame1 will change (from 1 to 2 or vice versa) every time Frame2 equals 10, and Frame2 will equal 10 every 12 cycles (it grows from 1 to 12 by 1 in every cycle and then drops to 1). We reduced the speed of rotation of the Frame1 variable! Change 12 to some other number to get a different speed of sprite rotation. Using several "Frame" variables in your code, some connected and some not, will become necessary in larger projects where you will have many objects represented with sprites that need to rotate with different speeds (monsters which walk with different paces, the speed of explosion animations, etc.). With "walking" objects you need to synchronize the speed of that object with sprite rotation (the best you can) or your "walking" object (player, monster, etc.) might seem like it’s sliding or running in place.

Last 4 conditions we'll add in the code are there to prevent the warrior to walk off the screen.

IF Player.X < 0 THEN 
Player.Move = FALSE
Player.X = 0
END IF
IF Player.X > 600 THEN 
Player.Move = FALSE
Player.X = 600
END IF
IF Player.Y < 0 THEN 
Player.Move = FALSE
Player.Y = 0
END IF
IF Player.Y > 440 THEN 
Player.Move = FALSE
Player.Y = 440
END IF

You should be able now to understand this code. Player.Move is changed to FALSE so that the warrior doesn't seem like he is trying to push the edge of the screen. Try to REM these lines (Player.Move = FALSE) and see it yourself.

The FINAL version of the code (for this lesson) looks like this (yippee!):

' Keyboard constants
CONST KEYDOWN& = &H5000
CONST KEYUP& = &H4800
CONST KEYLEFT& = &H4B00
CONST KEYRIGHT& = &H4D00
CONST KEYq& = &H71
CONST KEYESCAPE& = &H1B
' Other constants
CONST TRUE = 1
CONST FALSE = 0

TYPE ObjectType
	X          AS SINGLE
	Y          AS SINGLE
	Speed      AS SINGLE
	Frame      AS INTEGER
	Direction  AS INTEGER
	Move       AS INTEGER
	Attack     AS INTEGER
	Alive      AS INTEGER
END TYPE

DIM SHARED background1 AS LONG
DIM SHARED WarriorSprites AS LONG

DIM SHARED Player AS ObjectType
DIM SHARED Frame1 AS INTEGER, Frame2 AS INTEGER

Player.X = 100 ' Starting player's position and frame
Player.Y = 100
Player.Speed = 2      ' Always make sure to initiate
Player.Direction = 1  ' starting values to avoid errors
Player.Frame = 1      ' in the first loop.

SCREEN _NEWIMAGE(640, 480, 256) ' Sets the graphic mode
_MOUSEHIDE ' hide the mouse cursor

background1 = _LOADIMAGE("BACKGRND.bmp", 256)
_COPYPALETTE background1, 0
WarriorSprites = _LOADIMAGE("SPRITES.bmp")
_CLEARCOLOR 0, WarriorSprites

DO

	_LIMIT 60 ' limit FPS to 60

	' Player.Direction = 1 -> warrior moving right
	' Player.Direction = 2 -> warrior moving left
	' Player.Direction = 3 -> warrior moving down
	' Player.Direction = 4 -> warrior moving up

	Player.Move = FALSE ' By deafult the player is not
						' moving.
						
	' According to pushed key move the
	' player and flag the proper direction.
	IF _KEYDOWN(KEYRIGHT&) THEN 
		Player.X = Player.X + Player.Speed
		Player.Direction = 1
		Player.Move = TRUE
	END IF
	IF _KEYDOWN(KEYLEFT&) THEN 
		Player.X = Player.X - Player.Speed
		Player.Direction = 2
		Player.Move = TRUE
	END IF
	IF _KEYDOWN(KEYDOWN&) THEN 
		Player.Y = Player.Y + Player.Speed
		Player.Direction = 3
		Player.Move = TRUE
	END IF
	IF _KEYDOWN(KEYUP&) THEN 
		Player.Y = Player.Y - Player.Speed
		Player.Direction = 4
		Player.Move = TRUE
	END IF

	IF Player.X < 0 THEN 
		Player.Move = FALSE
		Player.X = 0
	END IF
	IF Player.X > 600 THEN 
		Player.Move = FALSE
		Player.X = 600
	END IF
	IF Player.Y < 0 THEN 
		Player.Move = FALSE
		Player.Y = 0
	END IF
	IF Player.Y > 440 THEN 
		Player.Move = FALSE
		Player.Y = 440
	END IF

	' Frame1 is used to animate the player
	' Frame2 is used to control/set after how many loops
	' Frame1 should switch from 1 to 2 and vice versa
	Frame2 = (Frame2 MOD 12) + 1
	IF Frame2 = 10 THEN Frame1 = (Frame1 MOD 2) + 1
	IF Player.Move = FALSE OR Frame1 = 0 THEN Frame1 = 1

	' According to player's direction flag the 
	' proper sprite (check in the tutorial on which
	' position each sprite is stored).
	IF Player.Direction = 1 THEN Player.Frame = 6 + Frame1
	IF Player.Direction = 2 THEN Player.Frame = 4 + Frame1
	IF Player.Direction = 3 THEN Player.Frame = 0 + Frame1
	IF Player.Direction = 4 THEN Player.Frame = 2 + Frame1

	_PUTIMAGE (0,0), background1, 0 ' paste background on 0,0 on the screen (last paremeter)

	_PUTIMAGE (Player.X, Player.Y), WarriorSprites, 0, ((Player.Frame-1)*40, 0)-(39+(Player.Frame-1)*40, 39)

	_DISPLAY

LOOP UNTIL _KEYDOWN(KEYq&) OR _KEYDOWN(KEYESCAPE&)

Compile and test the program.

Download the completed example compiled with the graphics files and extra comments: move_warrior.zip

Extra stuff: 32-bit color depth and example #2

If you want to convert example #2 into 32-bit color depth mode, you need to convert the two images used in that example to 32-bit color depth mode images. The best tool for this task is IrfanView, in my opinion. Just save the graphics file into PNG images with transparent color.

Another change you need to do is change the SCREEN statement and graphics loading code. The code:

SCREEN _NEWIMAGE(640, 480, 32) ' Sets the graphic mode
_MOUSEHIDE ' hide the mouse cursor

background1 = _LOADIMAGE("BACKGRND.png", 32)
WarriorSprites = _LOADIMAGE("SPRITES.png")

One more thing that might interest you at this point. If you want for your program to start full screen, just place _FULLSCREEN after the SCREEN statement.

Download the entire code with all the changes and new graphics files (32-bit version of example #2): move_warrior_32bit.zip

You might have noticed I didn't use any variable suffixes in this tutorial, but on the other hand used a lot of shared variables. I want to emphasize that the lack of suffixes and usage of SHARED variables (which are not even necessary in these single-module examples) represent my own coding style that I practice and prefer, but in no way advertise as the best.

For more details on statements used in this tutorial and when motivated to expand your QB64 knowledge, always refer to the official QB64 wiki: http://qb64.net/wiki/index.php?title=Main_Page

That's all for lesson #1.

In the next issue we'll deal with some more complex stuff, like artificial smarts and particles layers.

A tutorial written by Lachie D. (lachie13@yahoo.com ; The Maker Of Stuff)

Thanks to OlDosLover for the help.

FreeBASIC + Winsock P2P Chat Tutorial (With Non-Blocking Mode)

Written by Mark Koelemij (Marcade) and James Robert Osborne (WisdomDude) (June, 2012)

Introduction

Welcome to this tutorial! I have three questions for you:

1) Do you have some experience with FreeBASIC programming?
2) Do you have absolutely no knowledge in network programming?
3) Do you have absolutely no clue about Winsock?

If you've answered yes to all the above questions, then this tutorial is perfect for you! The awesome thing about this tutorial is that you will create a nifty peer to peer chat program! Not only that, but you'll make a chat program that can be used in two-player games, if done correctly! Also, if you've ever thought about making a multiplayer game that needs networking, then this tutorial is an excellent starting point!

For both advanced FreeBASIC users and newcomers, please have the following:

Windows XP, Vista, or 7
FreeBASIC v0.15 or newer
FBedit v1.0.7.6c or newer (Recommended, but not required)

If you already have FreeBASIC, it should come with this following file: inc/win/winsock2.bi

FreeBASIC has lots of IDEs out there, but we personally recommend FBedit. It has a drop-down list menu for selecting your dialect and saves your work before compiling and running your work! Your FreeBASIC will already feature different dialects, it will be recommended to use one of the legacy dialects. The one we encourage you to use is the "Depreciated GUI" dialect. This dialect is very easy and forgiving compared to the other dialects.

Just a quick note, this tutorial is designed to give you a hands-on approach with copying small pieces of code. All the small pieces of code related to Winsock will be explained in detail. Eventually, *every* single piece of code will build up towards a chat program! No larges amounts of excessive code will be used here, so no need to feel that any parts of code are a waste of time! To get the most out of this tutorial, it is highly, highly, HIGHLY recommended to do the following:

I M P O R T A N T

DO NOT skip parts of this tutorial. You must follow the instructions in order! In fact, find some way to note the parts you've already covered.
Copy every piece of code exactly the way it is presented. This includes the blank lines, the indented spacing, and the comments within the code!
Paste it exactly where it instructs you to paste them.
Save your work every time you've pasted some new code.
Do not compile/run, edit, or remove the pieces of code, until you're permitted to do so.
Have patience, because there's a lot to cover, and it will be worth it!

Now, before you can get to the good stuff, such as sending and receiving messages, you'll have to learn a lot of things. In this tutorial, you'll learn how Winsock operates, how networking in general works, and how sockets themselves work. Not only that, but you'll also learn what can go wrong, and how to fix problems on the way. The critical pieces of code will be explained in detail. The chat program will have lots of dependencies, so until you're permitted to run the code, you simply can't run the pasted code right away, until you're permitted to do so.

Let's explain networking, or more specifically, computer networking. What exactly is networking? Networking is simply two (or more) machines that are communicating to each other and/or passively sending and receiving data to each other. Whether these two (or more) machines are under the same roof, or one of them is on the other side of the world, it's still a network. Normally, one of them would be called a local area network, and the other a wide area network.

Blocking mode and non-blocking mode? What is that!? Blocking mode is a mode that halts/freezes your entire program until data is received. This means that if you wanted to run other operations in the background in real time, then you can pretty much forget about it. This is exactly why you'll want non-blocking mode, so you can smoothly run other operations uninterrupted in your main loop. Also, for this reason, you would have to keep checking for data received in every loop cycle.

The Tutorial

Are you ready to get started? Alright! Let's get started with coding your chat program! Create a new BAS file in FBedit. Next, copy and paste the following code into your blank BAS file:

#include "win/winsock2.bi"

' Custom string routines.
DIM SHARED Key$, InsertKey                ' Keyboard input stuff for later on.

' 640 x 480 
SCREEN 18, 8, 2

DO ' ======= MAIN LOOP

  ' Keyboard
  Key$ = INKEY                                                    ' Grab our key from keyboard.
  IF Key$ = CHR(255) + CHR(82) THEN InsertKey = InsertKey XOR 1   ' Toggle insert key state.

LOOP UNTIL Key$ = CHR(27) OR Key$ = CHR(255) + "k"  ' == END OF MAIN LOOP

Once you've pasted the code, run it! If this is successful, you'll see a blank window. Now, either hit ESC to terminate it or click on the 'X' button on the window to terminate it. This simply means you have win/winsock2.bi! If not, then it's most likely you don't have the file. Again, this is really important to have! Now, go ahead and save the file. Save it as any file name you wish, as long as you can remember it. You'll want to save your work often, as you're building towards a chat program!

Now, what's next? You need to fire up Winsock and close it down properly. When you fire up Winsock, you need to know what version you're going to run. As of now, the latest known version of Winsock is version 2.2. In the chat example, you'll use 2.0, just to show that you can use earlier versions as well. Before you make your Winsock start up routine, let's make your closing Winsock routine first. After all, shutting it down is a must! Copy and paste this at the very bottom of your code!

SUB Winsock_Close

' Winsock's shut down routine that cleans up everything associated with Winsock.
WSACleanUp
END

END SUB

WSACleanUp is Winsock's shut down routine to shut down sockets and clean up any Winsock usage. You will need to call this every time you call your Winsock start up routine. Now, let's work on your Winsock start up routine. Copy and paste the following code below the entire SUB Winsock_Close routine that you recently pasted:

SUB Winsock_Start

' Winsock's data structure has to be used to retrieve our version info.
DIM MakeOurWSAData AS WSAdata

' Fire up Winsock! We're requesting v2.0
IF WSAStartup(MAKEWORD(2, 0), @MakeOurWSAData) THEN
  SELECT CASE WSAGetLastError
    CASE WSASYSNOTREADY
      PRINT "Underlying Network subsystem is not ready."
    CASE WSAVERNOTSUPPORTED
      PRINT "The requested version is not supported."
    CASE WSAEINPROGRESS
      PRINT "A blocking Windows Sockets 1.1 operation is in progress."
    CASE WSAEPROCLIM
      PRINT "Winsock's usage has reached its limits by other programs."
    CASE WSAEFAULT
      PRINT "The second parameter is not a valid WSAData type."
    CASE ELSE
      PRINT "Unknown error. Error code (if any): ", WSAGetLastError
    END SELECT
  SLEEP
  END 
END IF

/'
  Even though we know that 2.0 (or higher) is supported, we will go ahead and check
  the highest version you have available. You may now use the returned values from
  MakeOurWSAData to pull up the highest available version of Winsock.
'/
OurVersionMajor$ = LTRIM(STR(MakeOurWSAData.wHighVersion AND 255))
OurVersionMinor$ = LTRIM(STR(MakeOurWSAData.wHighVersion SHR 8))
WinsockVersion$ = "v" + OurVersionMajor$ + "." + OurVersionMinor$

END SUB

The start up routine will display any possible errors as well as finding out the latest version of Winsock that is supported on your machine. It's important to know exactly what you have, in case Winsock ever makes any additional changes in the future. Anyways, before you can use your SUB routines, you need to declare them as well. Copy and paste this code below the "'#include "win/winsock2.bi"" line:

' Winsock specific calls.
DECLARE SUB Winsock_Close ()
DECLARE SUB Winsock_Start ()

DIM SHARED DummyStringA$, WinsockVersion$

Just a side note, we're keeping our SUB/FUNCTION routines in alphabetical order. After all, we'd like to easily navigate through our code when it starts turning into a large amount of code. Anyways, let's copy and paste the following code below your "If Key$ = CHR(255) + CHR(82)" line:

  ' Print version.
  LOCATE 1, 25: PRINT "Your version of Winsock is " + WinsockVersion$
  ' Print Polling status.
  LOCATE 26, 5: PRINT DummyStringA$

Just a quick explanation: The DummyStringA$ will be used for debugging purposes later on. The WinsockVersion$ will display your highest supported version, which is awesome! And now, last, but not least, let's make some calls to our Winsock routines! Copy and paste the following code above your "DO ' ======= MAIN LOOP" line:

Winsock_Start

And now, copy and paste this below the "LOOP UNTIL Key$ = CHR(27) OR Key$ = CHR(255) + "k"" line:

' Close Winsock and end the program!
Winsock_Close

Voila! If you've copied and pasted all the code as instructed, you may now run it! You should be able to see what version you have! This is excellent! If it doesn't work, go back and make sure you've copied and pasted all the previous code correctly as instructed.

Since your code will start to get larger, you'll want to know where and when errors can occur. Let's make a custom routine that prints out errors! This will be needed in case we actually do come across any errors. Copy and paste the code above the "SUB Winsock_Close" routine:

SUB PrintErrorEnd (ErrorMessage$) ' END Program with error.

' Here, you'd like to know why you got an error, so print it out on screen!
CLS
COLOR 15
WSACleanUp
PRINT ErrorMessage$
PRINT "Error code: (IF applicable)", WSAGetLastError
SLEEP
END

END SUB

And now, let's declare the PrintErrorEnd routine! Copy and paste it below the "#include "win/winsock2.bi"" line:

DECLARE SUB PrintErrorEnd (ErrorMessage$)

The chances are, you shouldn't have any errors at this point, however, it is possible to come across them later on, esp. when you're dealing with sockets! If everything has been successful so far, then you might not come across any issues later on. Who knows? When working with sockets, anything can happen, so you need to be prepared for that. Speaking of sockets, let's talk about sockets! I'm sure some of you are wondering what sockets are and what do they do.

Sockets are a lot like doors. These doors allow incoming and outgoing data, or you can set them one-way. The cool thing about Winsock, is that it allows multiple sockets, which is great if you're wanting to, for example, make a multiplayer game! In your chat program, you will be using three sockets! One of them will be used to retrieve your public IP address online, one of them will be used for listening incoming connections, and one of them will be the main socket for chatting!

Before using sockets, you'll have to define them, and set some specific properties for it. You'll definitely want it to have Winsock's "SOCKET" data type, a send and receive data buffer, and you'll want to know the status of the socket. You'll also want to know how many sockets you're planning to use and give them an easy to remember handle name. Copy and paste the following code above the "DECLARE SUB PrintErrorEnd (ErrorMessage$)" line:

' CONSTants
CONST Socket_Buffer_Size = 2048       ' Socket Send/Receive buffer size
CONST Socket_Buffer_Get = 255         ' How many bytes to get per loop

' Types
TYPE Our_Socket_Type
  sSocket AS SOCKET       ' Winsock assigns its own SOCKET data type for sSocket.
  State AS UBYTE                              ' This is the status.
  SendBuffer AS ZSTRING * Socket_Buffer_Size  ' 2k is sufficient enough.
  SendBytes AS ULONG                          ' The amount of bytes to send.
  RecvBuffer AS ZSTRING * Socket_Buffer_Size  ' 2k is sufficient enough.
  RecvBytes AS ULONG                          ' The amount of bytes to receive.
END TYPE

' We'll use 3 sockets in our chat program.
CONST Max_Sockets = 3
DIM SHARED Our_Sockets(1 TO Max_Sockets) AS Our_Socket_Type

' Our sockets' handles.
DIM SHARED Listen_Socket AS UBYTE, Main_Socket AS UBYTE, HTTP_Socket AS UBYTE, PORT AS UINTEGER  ' Socket handles used in Connect 4 FB.

Now, before you can even think about using sockets, you need to make a routine that will find an unused socket. Also, inside the routine, you'll need to reset its properties in case it's been previously used. Sockets can be reused over and over again. Copy and paste this routine below your entire SUB PrintErrorEnd routine:

FUNCTION Socket_New

DIM Check_This_Socket AS BYTE

' Look through all of our sockets, and find one that's not used.
FOR Check_This_Socket = 1 TO UBOUND(Our_Sockets)
  IF Our_Sockets(Check_This_Socket).State = Socket_Is_Closed THEN
    ' New unused socket found, use it
    Our_Sockets(Check_This_Socket).sSocket = 0      ' Making sure everything is NULL.
    Our_Sockets(Check_This_Socket).SendBuffer = ""
    Our_Sockets(Check_This_Socket).SendBytes = 0
    Our_Sockets(Check_This_Socket).RecvBuffer = ""
    Our_Sockets(Check_This_Socket).RecvBytes = 0
    Socket_New = Check_This_Socket  ' Return the value of the unused socket that was found.
    EXIT FOR
  END IF
NEXT Check_This_Socket

END FUNCTION

Now, you might be wondering why Socket_Is_Closed is there. It isn't defined it yet, but you will do that next. Before doing that, let's go ahead and DECLARE your Socket_New function: Copy and paste this below the "DECLARE SUB Winsock_Start ()" line.

DECLARE FUNCTION Socket_New () ' Finds an unused socket to use.

Previously, you've declared the properties of your sockets. Now you need to know the status of your sockets! You'll need to know the states more than you think! You need to know if a socket is currently opened, closed, connecting, connected, listening, closing, or has an error. This is why we have CONSTs for them. Copy and paste this below your "CONST Socket_Buffer_Get = 255" line:

CONST Socket_Is_Closed = 0            ' Socket is closed, or not used.
CONST Socket_Is_Open = 1              ' Socket is open.
CONST Socket_Is_Listening = 2         ' Socket is listening.
CONST Socket_Is_Connecting = 3        ' Socket is connecting.
CONST Socket_Is_Connected = 4         ' Socket is connected.
CONST Socket_Is_Closing = 5           ' Socket is closing connection.
CONST Socket_Is_Error = 6             ' Socket encountered an error.

Nice! You've defined your socket states! This will help you out later on. Now that you know you're using a fresh socket from your "Socket_New" function, you will no longer have to worry about using a socket that's already in use! This is really useful when you need to open multiple sockets! Next, I will talk about opening a socket.

Now, when you open any socket, you need to keep in mind that they need to be closed down eventually as well. You can either close them soon or later individually, or you can have the Winsock_Close routine close all the sockets automatically. With that being mentioned, let's start making an open socket routine!

Since you're opening a socket, you're going to do a lot of things to set this socket up and running. You'll be telling Winsock what kind of address family you'll use, the protocol you want, and what kind of Input/Output method to use. This is where you tell it to be in non-blocking mode! More details are provided in the code comments from the routine below. Copy the following code and paste it below the "Winsock_Close" line:

FUNCTION Make_Socket_Open (BYREF This_Socket AS UBYTE) AS BYTE

' Set Non-blocking mode on.
DIM NonBlocking AS LONG
NonBlocking = 1

' Get unused Socket from our routine!
This_Socket = Socket_New
IF This_Socket = -1 THEN EXIT FUNCTION ' No more sockets available!

' Winsock's open socket routine
Our_Sockets(This_Socket).sSocket = OpenSocket(AF_INET, SOCK_STREAM, IPPROTO_TCP)

/'
  Winsock's socket protocol parameters: This is what we'll use.
  AF_INET      (As opposed to AF_INET6)     Since we're using IPv4 instead of IPv6 for IP addresses.
  SOCK_STREAM  (As opposed to SOCK_DGRAM)   Since we're using a connection-based socket, we use this.
  IPPROTO_TCP  (As opposed to IPPROTO_UDP)  TCP is slower than UDP, but ensures reliability and delivers data in the correct order.

  The first parameter is the address family. We'll be using IPv4. While IPv6 is slowly catching up
  (as of now), IPv4 is still the standard. It's also easier to type since it only goes up to 15
  characters with decimal numbers.

  The second parameter is simply telling it we're using a stream (constant connection, kinda like a live phone connection) that will
  be used for TCP.

  For chatting, we're using TCP protocol. TCP is a connection-based real time protocol. Unlike UDP
  (Datagram), TCP is designed to make sure you receive packets (chunks of data), and in the 
  correct order they were sent out. UDP (Datagram) is faster, doesn't need a constant streaming connection,
  however, it doesn't check to see if you received your packets in order, or if you even got the packets at all!
  For this reason, TCP is much easier to work with since it's designed to be reliable.
'/

IF Our_Sockets(This_Socket).sSocket = NULL THEN EXIT FUNCTION

/'
  The ioctlsocket function controls the I/O mode of a socket, which you will put your
  sockets into non-blocking mode. The FIONBIO and @lNonBlocking mode is basically telling
  FIONBIO (non-blocking command) to equal to 1, meaning non-blocking is now enabled
  (nonzero value enables it).

  Since you have non-blocking mode on, this will prevent the recv() function from halting your
  program.

'/
IF ioctlsocket(Our_Sockets(This_Socket).sSocket, FIONBIO, @NonBlocking) = -1 THEN EXIT FUNCTION

Our_Sockets(This_Socket).State = Socket_Is_Open ' Now tell it that the socket is open.
Make_Socket_Open = -1 

END FUNCTION

Great, now let's declare it! Copy the following code and paste it above the "DECLARE FUNCTION Socket_New ()" line:

DECLARE FUNCTION Make_Socket_Open (BYREF This_Socket AS UBYTE) AS BYTE         ' Open up a socket.

For testing purposes, go ahead and copy the following code and paste it below the "Winsock_Start" line:

DummyStringA$ = STR(Make_Socket_Open(Main_Socket))

The entire code so far: winsock_code1.txt

Now, run it! Do you see a "-1" at the bottom-left corner of the window? If so, This is excellent! You've just opened up a socket successfully! Winsock_Close will close any opened sockets for you automatically, however, what if you have several opened sockets, and need to close just one? This is where you need to make the Make_Socket_Close routine. It's actually easy to write! Copy and paste the following code above the entire FUNCTION Make_Socket_Open routine:

FUNCTION Make_Socket_Close (BYREF This_Socket AS UBYTE) AS BYTE

' Winsock's routine to close down both incoming and outgoing networking operations.
ShutDown Our_Sockets(This_Socket).sSocket, SD_BOTH

' ow disconnect the handle and check to see if it's closed completely.	
IF CloseSocket(Our_Sockets(This_Socket).sSocket) = 0 THEN
  Our_Sockets(This_Socket).State = Socket_Is_Closed ' Closed socket
  This_Socket = 0                                   ' Unassign socket
  Make_Socket_Close = -1                            ' Return true for successful close down.
ELSE
  Our_Sockets(This_Socket).State = Socket_Is_Error ' Failed to close socket
  Make_Socket_Close = 0		
END IF

END FUNCTION

Great, now let's declare your function. Copy the following code and paste it above the "DECLARE FUNCTION Make_Socket_Open" line:

DECLARE FUNCTION Make_Socket_Close (BYREF This_Socket AS UBYTE) AS BYTE ' Close the socket.

Now, for one more test. Let's copy the following code and paste it below the "DummyStringA$ = STR(Make_Socket_Open(Main_Socket))" line:

DummyStringA$ += STR(Make_Socket_Close(Main_Socket))

Now, run it! Did you see a "-1-1" at the bottom left screen? If so, that's awesome! You've opened and closed a socket successfully! Sure, you've came a long way to get this far to test out your sockets, but hey, you've done it! You've officially opened and closed a socket! So now what? Well, let's start connecting a socket! Before you can do that, you need to know how to connect, and most of all, what name/address to connect to! You may even have to resolve the name/address before connecting! Let's make a routine that will resolve the name/address. Copy the following code and paste it below the FUNCTION Make_Socket_Open routine:

FUNCTION Make_Socket_Resolve (BYVAL stHostName AS STRING) AS INTEGER

' Internet address and host entry header.
DIM ia AS in_addr
DIM hostentry AS hostent PTR

' Check if it's an actual ip address
ia.S_addr = inet_addr(stHostName) ' This converts a string containing an IPv4 dotted-decimal
                                  ' address into a proper address for the IN_ADDR structure.
IF ia.S_addr = INADDR_NONE THEN
' IF not, assume it's a name. Use Winsock's routine to resolve it.
  hostentry = gethostbyname(stHostName)
  IF hostentry = 0 THEN	EXIT FUNCTION
  Make_Socket_Resolve = *CAST(INTEGER PTR, *hostentry->h_addr_list)
ELSE 
' Just return the address
  Make_Socket_Resolve = ia.S_addr
END IF

END FUNCTION

And now, let's declare it! Copy the following code and paste it below your "DECLARE FUNCTION Make_Socket_Open" line:

DECLARE FUNCTION Make_Socket_Resolve (BYVAL stHostName AS STRING) AS INTEGER

And now, copy the following code and paste it below your "DummyStringA$ += STR(Make_Socket_Close(Main_Socket))" line:

DummyStringA$ += "  " + STR(Make_Socket_Resolve("127.0.0.1"))

The entire code so far: winsock_code2.txt

Great! Now run it! Did it come out "-1-1 16777343" at the bottom left? If so, excellent! This is your IP address "127.0.0.1" being converted to a large number! How? Here's the math:

(127) + (0) * 256 + (0) * 65536 + (1) * 16777216 = 16777343

The address name has been resolved! Now you can use it with your sockets!

As mentioned, before you can connect, you need to decide which socket you want to connect with, the resolved address to connect to, and which port number on your machine you're going to use. Ports?! What are those?! Ports are a lot like sub-addresses. The number range for port numbers can be anywhere from 0 to 65,535. Some ports are dedicated, and some are free to use. At this point, you might be wondering what port number to use!

Here's a website that will show you exactly what to use:

http://en.wikipedia.org/wiki/List_of_TCP_and_UDP_port_numbers

At the bottom of the wikipedia page, you can see that the port numbers 49,152 to 65,535 can be used for whatever purpose you desire. You may even decide what number to use in that range, it's up to you. At this point, all you should be interested in doing, is getting a port number to bind (associate) with your socket. Once you do that, you can start using the socket. Anytime you're using a socket to connect (or listen for incoming connections), you have to associate (bind) your socket with a port. Copy and paste this below your "DIM SHARED Key$, InsertKey" line:

' Randomly selected port number to use for listening and/or connecting.
PORT = 49952

And now, it is time to make a socket connecting routine! Without this, you'd have no way to communicate with other machines! Copy the following code and paste it below your entire FUNCTION Make_Socket_Close routine:

FUNCTION Make_Socket_Connect (BYREF This_Socket AS UBYTE, BYVAL stHostName AS STRING, BYVAL PORT AS INTEGER) AS BYTE

' Socket address and IP
DIM sa AS sockaddr_in
DIM iIP AS INTEGER

' Check IF Socket is in Open State
IF Our_Sockets(This_Socket).State <> Socket_Is_Open THEN EXIT FUNCTION

' Resolve address
iIP = Make_Socket_Resolve(stHostName)

' Socket address header
sa.sin_port = htons(PORT)  ' htons changes the byte format. Port number gets associated.
sa.sin_family = AF_INET    ' IPv4 address as opposed to IPv6 (AF_INET6)
sa.sin_addr.S_addr = iIP   ' Our resolved IP number.

' This is Winsock's connect routine.
IF Connect(Our_Sockets(This_Socket).sSocket, CAST(PSOCKADDR, @sa), LEN(sa)) <> SOCKET_ERROR THEN
  Our_Sockets(This_Socket).State = Socket_Is_Connecting   ' Socket connecting
  Make_Socket_Connect = -1
ELSE
  IF WSAGetLastError = WSAEWOULDBLOCK THEN                ' Normal, blocking mode is on.
    Our_Sockets(This_Socket).State = Socket_Is_Connecting ' Socket connecting
    Make_Socket_Connect = -1
  ELSE
    Our_Sockets(This_Socket).State = Socket_Is_Error      ' Failed to connect
  END IF
END IF

END FUNCTION

And now, declare it! Copy the following code and paste it below the "DECLARE FUNCTION Make_Socket_Close" line:

DECLARE FUNCTION Make_Socket_Connect (BYREF This_Socket AS UBYTE, BYVAL stHostName AS STRING, BYVAL PORT AS INTEGER) AS BYTE

Nice! Let's make it connect! So far, you've been copying and pasting code. Now it's time to remove a couple of lines of code. Delete the following lines of code:

DummyStringA$ += STR(Make_Socket_Close(Main_Socket))
DummyStringA$ += "  " + STR(Make_Socket_Resolve("127.0.0.1"))

And now, add this below the "DummyStringA$ = STR(Make_Socket_Open(Main_Socket))" line:

DummyStringA$ += STR(Make_Socket_Connect(Main_Socket, "127.0.0.1", PORT))

Now run it! Does it come out "-1-1" at the bottom left? If so, then you've created your connecting routine! This will allow you to link to any machine that is set up to receive your connection request! In case you're wondering why you're using "127.0.0.1", it's a loopback address! You might be asking what is that? It's basically your machine's local address! That's right! You're connecting back to your own machine! Why? Let me explain; you will test two copies (instances) of your program on the same machine! More on this will be discussed later on!

Now, even though you'll connect two copies of your program to each other, a connection routine isn't enough. After all, the only thing it really does is open a request to connect. You need a way to accept that connection request! This means you'll also need a listening socket that listens for incoming connection requests! Before you can even set your socket to listen, you need to associate (bind) your listening socket to a port! Let's recap: Before accepting incoming connection requests, the socket needs to listen, before socket can listen, it needs to know which port to be associated (binded) with!

Let's create a routine that will bind your socket to a port. Copy the following code and paste it above the FUNCTION Make_Socket_Close routine:

FUNCTION Make_Socket_Bind (BYREF This_Socket AS UBYTE, BYVAL PORT AS INTEGER) AS INTEGER

' Socket address header
DIM sa AS sockaddr_in
sa.sin_port = htons(PORT)       ' Convert the byte order for PORT.
sa.sin_family = AF_INET         ' IPv4
sa.sin_addr.S_addr = INADDR_ANY ' Any address format. 

' Here, we associate a socket with our port.
Make_Socket_Bind = Bind(Our_Sockets(This_Socket).sSocket, CAST(PSOCKADDR, @sa), LEN(sa)) <> SOCKET_ERROR

END FUNCTION

You might be wondering why a socket needs to be binded with a port. The explanation is simple; you've made a connecting routine that previously used the same port number. As mentioned, the port numbers are like sub-addresses, or like the rooms in your house. Your machine will handle all kinds of incoming and outgoing data constantly from other programs. It is important that your program sends and receives data that is exclusively assigned (via port number) to your program. That is why you bind your port to your socket. Now, let's go ahead and declare your binding routine. Copy the following code and paste it above the "DECLARE FUNCTION Make_Socket_Close" line:

DECLARE FUNCTION Make_Socket_Bind (BYREF This_Socket AS UBYTE, BYVAL PORT AS INTEGER) AS INTEGER ' Bind the socket to a particular port.

Great, so now let's make a listening routine! This will be the routine that gets called after binding it to a port. The listen() will run at all times til you close it. This is good when you're trying to accept multiple incoming connection requests. Anyways, copy the following code and paste it below the Make_Socket_Connect routine:

FUNCTION Make_Socket_Listen (BYREF This_Socket AS UBYTE, BYVAL TimeOut AS INTEGER = SOMAXCONN) AS BYTE

' Winsock's Listen() routine doesn't need a non-zero number for TimeOut since we're in non-blocking mode.
IF Listen(Our_Sockets(This_Socket).sSocket, TimeOut) <> SOCKET_ERROR THEN
  Our_Sockets(This_Socket).State = Socket_Is_Listening
  Make_Socket_Listen = -1	
END IF

END FUNCTION

And now, let's go ahead and declare it! Copy the following code and paste it below the "DECLARE FUNCTION Make_Socket_Connect" line:

DECLARE FUNCTION Make_Socket_Listen (BYREF This_Socket AS UBYTE, BYVAL TimeOut AS INTEGER = SOMAXCONN) AS BYTE

Great, now let's remove a line of code. Delete the following line:

DummyStringA$ += STR(Make_Socket_Connect(Main_Socket, "127.0.0.1", PORT))

And now, add these two lines of code below the "DummyStringA$ = STR(Make_Socket_Open(Main_Socket))" line:

DummyStringA$ += STR(Make_Socket_Bind(Main_Socket, PORT))
DummyStringA$ += STR(Make_Socket_Listen(Main_Socket, 0))

Before you run this, I should mention that Windows may give you a firewall warning prompt. If so, don't panic! It's just telling you that the program you're running is using Winsock's listen() routine. Just click on "Unblock" or "Allow Access", which ever is applicable. Unfortunately, there's some programmers out there that misuse this feature for malicious purposes. With that in mind, you might want to warn your users about this prompt. If anything, let them know what it means and remind them that Window's firewall is doing its job.

Go ahead and run it! If you're seeing "-1-1" at the bottom left, then everything is running great so far! If you're seeing "-10", then something went unsuccessful when binding! The chances are, another program is already using the same port number you're using. Change the variable 'PORT' value by incrementing the value until you get "-1-1" as your result. Unfortunately, this is one of the drawbacks when using an arbitrary port number on the same machine.

Even though your socket is listening, it still needs to know if you want to accept the incoming connection request or not. With that in mind, you will use Winsock's accept() routine. Let's go ahead and make an accept routine. Copy the following code and paste it above the "FUNCTION Make_Socket_Bind" routine:

FUNCTION Make_Socket_Accept (BYREF This_Socket AS UBYTE, BYREF Second_Socket AS UBYTE) AS SOCKET

' Socket address and length.
DIM sa AS sockaddr_in
DIM salen AS INTEGER 

' Get a new socket reserved for our accepted connection.
Second_Socket = Socket_New
IF Second_Socket = -1 THEN
  ' No more sockets available. Cannot accept connection
  Make_Socket_Accept = Make_Socket_Close(This_Socket)
  EXIT FUNCTION
END IF

' Get length
salen = LEN(sa)

' Accept any incoming connections and use our new socket for it.
Our_Sockets(Second_Socket).sSocket = Accept(Our_Sockets(This_Socket).sSocket, CAST(PSOCKADDR, @sa), @salen)
IF Our_Sockets(Second_Socket).sSocket > 0 THEN
  ' Succeeded in accepting connection
  Our_Sockets(Second_Socket).State = Socket_Is_Connected
END IF

END FUNCTION

And now, declare it! Copy the following code and paste it above the "DECLARE FUNCTION Make_Socket_Bind" line:

DECLARE FUNCTION Make_Socket_Accept (BYREF This_Socket AS UBYTE, BYREF Second_Socket AS UBYTE) AS SOCKET ' Accept incoming connection.

Now, even though you've made an accepting connection routine, you're basically making a copy of all the attributes from the listening socket to the new socket. Why a whole new socket? Well, it's good practice, esp. if you ever need to keep your listening socket active at all times. This would definitely be true if you plan on making a multiplayer game that can connect and disconnect any time while your host (server) program stays running all the time. Anyways, you're almost done with the socket routines! Now we need to send stuff! Let's make a sending routine! Copy the following code and paste it below your Make_Socket_Resolve routine:

FUNCTION Make_Socket_Send (BYREF This_Socket AS UBYTE) AS INTEGER

DIM BytesToSend AS INTEGER
DIM zsBuffer AS ZSTRING * (Socket_Buffer_Get + 1)

' Get length
BytesToSend = LEN(Our_Sockets(This_Socket).SendBuffer)
IF BytesToSend = 0 THEN EXIT FUNCTION

' Truncate data to maxmimum get
IF BytesToSend > Socket_Buffer_Get THEN BytesToSend = Socket_Buffer_Get

' Grab a small chunk of our data.
zsBuffer = LEFT(Our_Sockets(This_Socket).SendBuffer, BytesToSend) 

' Update the buffer's string and length.
Our_Sockets(This_Socket).SendBuffer = MID(Our_Sockets(This_Socket).SendBuffer, BytesToSend + 1)
Our_Sockets(This_Socket).SendBytes = Our_Sockets(This_Socket).SendBytes + BytesToSend

' Tell Winsock to send our small chunk of data.
BytesToSend = Send(Our_Sockets(This_Socket).sSocket, @zsBuffer, BytesToSend, 0)
Make_Socket_Send = BytesToSend

END FUNCTION

And now, copy the following code and paste it below the "DECLARE FUNCTION Make_Socket_Resolve" line:

DECLARE FUNCTION Make_Socket_Send (BYREF This_Socket AS UBYTE) AS INTEGER

As you can see, you want to keep the string's length and data updated when you send data. This will be very important when you need to poll the data that was sent. And now, let's start receiving the data that was sent! Copy the following code and paste it above your Make_Socket_Resolve routine:

FUNCTION Make_Socket_Receive (BYREF This_Socket AS UBYTE) AS INTEGER

DIM zsBuffer AS ZSTRING * (Socket_Buffer_Get + 1)
DIM BytesReceived AS INTEGER

' Maximum amount to grab at a time.
BytesReceived = Socket_Buffer_Get

' Running out of buffer, let's roll it over.
IF LEN(Our_Sockets(This_Socket).RecvBuffer) + Socket_Buffer_Get > SIZEOF(Our_Sockets(This_Socket).RecvBuffer) THEN
  BytesReceived = SIZEOF(Our_Sockets(This_Socket).RecvBuffer) - LEN(Our_Sockets(This_Socket).RecvBuffer) - 1
  IF BytesReceived < 1 THEN EXIT FUNCTION
END IF

' Winsock's routine to receive data
BytesReceived = Recv(Our_Sockets(This_Socket).sSocket, @zsBuffer, Socket_Buffer_Get, 0)

' Data has been received! Now let's put it into our buffer!
IF BytesReceived > 0 THEN
  Our_Sockets(This_Socket).RecvBuffer = Our_Sockets(This_Socket).RecvBuffer + zsBuffer
  Our_Sockets(This_Socket).RecvBytes = Our_Sockets(This_Socket).RecvBytes + BytesReceived
END IF

' This will return non-zero for data being received.
Make_Socket_Receive = BytesReceived

END FUNCTION

If you look carefully, the routine tries to make sure the receiving buffer doesn't overflow. Without it, the program will end up buggy or possibly unresponsive. Always make sure your receiving buffers are designed to handle the incoming data. Just a quick note: The difference between LEN and SIZEOF, is that LEN returns the length of the data's content, while SIZEOF return's the total length of the buffer itself, regardless of content. Let's go ahead and declare your routines: Copy the following code and paste it above the "DECLARE FUNCTION Make_Socket_Resolve" line:

DECLARE FUNCTION Make_Socket_Receive (BYREF This_Socket AS UBYTE) AS INTEGER   ' Get stuff from remote user.

Congratulations! You're nearly done with the socket routines in place! Since your sockets are already designed to be in non-blocking mode, you will need to poll those sockets! Let's start polling them. This routine will be the most exhausting one to cover, so brace yourself! First off, before you do so, you need a quick routine that will identify the socket handle by its "sSocket" id. Remember, when you open a new socket, it assigns a unique value from sSocket. This one just does the reverse, by giving us the index from the socket's sSocket ID! Let's make a quick routine: Copy the following code and paste it below your SUB PrintErrorEnd routine:

FUNCTION Socket_Index (BYREF sSocket AS SOCKET) AS BYTE

DIM Check_This_Socket AS BYTE

' Look through our sockets and identify which one has our sSocket value.
FOR Check_This_Socket = 1 TO UBOUND(Our_Sockets)
  IF Our_Sockets(Check_This_Socket).sSocket = sSocket THEN
    Socket_Index = Check_This_Socket
    EXIT FOR
  END IF
NEXT Check_This_Socket

' Not found
IF Check_This_Socket > UBOUND(Our_Sockets) THEN Socket_Index = -1

END FUNCTION

The routine will be used as the socket handle's reverse look-up by specifying the socket's sSocket ID. Later on, when polling, you will see why this is needed! Now let's declare it as well! Copy the following code and paste it above the "DECLARE FUNCTION Socket_New ()" line:

DECLARE FUNCTION Socket_Index (BYREF sSocket AS SOCKET) AS BYTE                 ' Find Socket's UID by sSocket's ID

Great, let's start working on polling these sockets! This is where the sockets get updated by Winsock itself! The function that makes it all happen is SelectSocket(). It will sync up all the reading/writing operations. Before calling SelectSocket(), you'll need to check if the socket is active for operations first. Since we're dealing with multiple sockets, you'll create a read/write/except array set for that reason. There's a LOT of things that are happening, so make sure to read the code comments to understand what's going on.

Brace yourself! Copy the following code and paste it below the FUNCTION Make_Socket_Send routine:

FUNCTION Poll_Our_Sockets

' Winsock has their own DATA types. 
DIM read_fd_set AS fd_set     ' sSocket ID and counter will be utilized by these.
DIM write_fd_set AS fd_set
DIM except_fd_set AS fd_set
DIM TimeOutValues AS timeval  ' We'll use zero since we're in non-blocking mdoe.
DIM Dummy AS INTEGER
DIM iTemp AS INTEGER          ' Loop counter.
DIM This_Socket AS BYTE       ' Checking our used sockets counter.       
DIM Second_Socket AS BYTE     ' When accepting a connection, the second socket will be a copy of the listening socket.

' We will check all the sockets for any active operations.
FOR This_Socket = 1 TO UBOUND(Our_Sockets) 	

 ' If a socket is listening, connecting, connected, or closing, then add them to the list.
  CheckThis = 0
  SELECT CASE Our_Sockets(This_Socket).State 
    CASE Socket_Is_Listening: CheckThis = 1
    CASE Socket_Is_Connecting: CheckThis = 1
    CASE Socket_Is_Connected: CheckThis = 1
    CASE Socket_Is_Closing: CheckThis = 1
  END SELECT

  /'
  When a socket needs to be checked, we add it to the list of sockets to be read and polled
  later on by SelectSocket().
  '/

  IF CheckThis THEN ' Add the active socket to the list.
    read_fd_set.fd_array(read_fd_set.fd_count) = Our_Sockets(This_Socket).sSocket
    read_fd_set.fd_count = read_fd_set.fd_count + 1
    write_fd_set.fd_array(write_fd_set.fd_count) = Our_Sockets(This_Socket).sSocket
    write_fd_set.fd_count = write_fd_set.fd_count + 1
    except_fd_set.fd_array(except_fd_set.fd_count) = Our_Sockets(This_Socket).sSocket
    except_fd_set.fd_count = except_fd_set.fd_count + 1
  END IF
NEXT This_Socket

' IF there's nothing to poll, then leave this routine!
IF read_fd_set.fd_count = 0 AND write_fd_set.fd_count = 0 AND except_fd_set.fd_count = 0 THEN EXIT FUNCTION

/'
  When you're polling your sockets, you'll end up checking all possible read, write, and error
  operations that have happened. Winsock's internal routines will capture all the current r/w/e updates,
  as long as we keep calling SelectSocket. This is where all the read/write/error polling happens!
'/
Dummy = SelectSocket(read_fd_set.fd_count, @read_fd_set, @write_fd_set, @except_fd_set, @TimeOutValues)

' Debugging purposes. Sometimes, we want to know if our sockets are reading, writing, or having errors, at all! 
DummyStringA$ = "READ: " + STR(read_fd_set.fd_count) + "  WRITE: " + STR(write_fd_set.fd_count) + "  EXCEPT: " + STR(except_fd_set.fd_count )

' IF return value is zero, no changes	
IF Dummy = 0 THEN EXIT FUNCTION

 ' IF it is less than zero, something happened	
IF Dummy < 0 THEN Poll_Our_Sockets = -1

 ' Check readability of sockets
FOR iTemp = 0 TO (read_fd_set.fd_count - 1)

  ' Remember this routine? Let's find which socket handle needs polling by its sSocket ID.
  This_Socket = Socket_Index(read_fd_set.fd_array(iTemp))
  
  IF This_Socket > -1 THEN  ' Socket is readable.

  /'
  Since the socket is now readable, let's make it to where...
  1) A listening socket accepts an incoming connection.
  2) A connecting socket becomes a connected socket.
  3) A connected socket grabbing any possible incoming data.
  4) A closing socket becomes a closed socket.
  '/

    SELECT CASE Our_Sockets(This_Socket).State
      CASE Socket_Is_Listening
        Dummy = Make_Socket_Accept(This_Socket, Second_Socket)
      CASE Socket_Is_Connecting
        Our_Sockets(This_Socket).State = Socket_Is_Connected
      CASE Socket_Is_Connected
        Dummy = Make_Socket_Receive(This_Socket)
        IF Dummy = 0 THEN
          ' 0 bytes received, means remote peer closed connection
          Our_Sockets(This_Socket).State = Socket_Is_Closing
        END IF
      CASE Socket_Is_Closing
        IF LEN(Our_Sockets(This_Socket).RecvBuffer) = 0 THEN
          Dummy = Make_Socket_Close(This_Socket) ' IF receive buffer is empty, close socket
        END IF	
    END SELECT
  END IF
NEXT iTemp

 ' Check writability of sockets
FOR iTemp = 0 TO (write_fd_set.fd_count - 1)
  This_Socket = Socket_Index(write_fd_set.fd_array(iTemp))

  IF This_Socket > -1 THEN   ' Socket is writable.

  /'
  Since the socket is now writable, let's make it to where...
  1) A connecting socket becomes a connected socket.
  2) A connected socket sends any available content.
  '/

    SELECT CASE Our_Sockets(This_Socket).State
      CASE Socket_Is_Connecting
        Our_Sockets(This_Socket).State = Socket_Is_Connected
      CASE Socket_Is_Connected
        iRetVal = Make_Socket_Send(This_Socket)
    END SELECT
  END IF
NEXT iTemp

 ' Check exceptions of sockets
FOR iTemp = 1 TO (except_fd_set.fd_count - 1)
  This_Socket = Socket_Index(except_fd_set.fd_array(iTemp))

  IF This_Socket > -1 THEN  ' Socket encountered an error.

  ' An error occured with the socket.

    Our_Sockets(This_Socket).State = Socket_Is_Error
    iRetVal = Make_Socket_Close(This_Socket)
  END IF
NEXT iTemp

END FUNCTION

And now, declare it. Copy the following code and paste it above the "DECLARE FUNCTION Socket_Index" line:

DECLARE FUNCTION Poll_Our_Sockets ()

And now, let's expand your main loop! You'll make a loop that updates the page on every loop cycle. Copy the following code and paste it below the "DIM SHARED Listen_Socket AS UBYTE" line:

DIM SHARED Workpage AS INTEGER, Polling AS INTEGER

And now, copy the following code and paste it below the "DO" line, which is the beginning of your main loop:

  ' Update screen.
  SCREENSET Workpage, Workpage XOR 1
  CLS

  ' Animate some of our stuff, and use this as the frame counter/index.
  FrameAnimate = (FrameAnimate + 1) AND 255
  
  ' Socket must always poll!
  Polling = Poll_Our_Sockets

And now, copy the following code and paste it below the "LOCATE 26, 5: PRINT DummyStringA$" line:

  ' Flip work page.
  WorkPage XOR = 1 
  SLEEP 5

The entire code so far: winsock_code3.txt

Run the code, and you should see "READ: 0 WRITE: 0 EXCEPT: 0" at the bottom left. If so, then everything went successful! You now have a loop that's polling and refreshing the screen! Just to prove it, copy the following code and paste it above the "WorkPage XOR = 1" line:

  ' Grabbing IP address smoothly in background.
  COLOR 14
  LOCATE 28, 5 + (FrameAnimate SHR 3): PRINT ".. Polling our sockets in background .."
  COLOR 15
  LOCATE 29, 5: PRINT "Hit ESC any time to quit this chat app!"

Awesome! Now run it! You should see an animated scrolling text! This is showing that you can, in fact, have socket operations run smoothly in the main loop! So far, you have every routine needed for Winsock's sockets! Congratulations! Now you'll need to make some custom routines! Let's start off with a routine that detects a valid IP address.

Earlier, you've made a Make_Socket_Resolve that used inet_addr() for detecting a valid IP address. While it already serves its purpose, we'd like to make our own with some restrictions. We'd like it to exclusively use a 4-part IP address, using only decimals numbers (0 to 9), and must always have 3 dots in between. Sure, you'll be adding limitations, but this will definitely come in handy later on!

Copy the following code and paste it above the SUB Winsock_Close routine:

FUNCTION ValidIP (BYVAL IPAddr$) AS INTEGER

/'
  This custom routine checks for a valid IP address.
  We use the traditional dotted IP address format.
  We know that valid IP addresses have the following:

  1) The length must be 7 to 15 characters in length (x.x.x.x to xxx.xxx.xxx.xxx)
  2) It must contain dots, numbers, and nothing else.
  3) It must contain exactly 3 dots.
  4) The dots will be in between numbers.
  5) The numbers' values will have a range of 0 to 255.
'/

DIM ValidCharIP$, Dot1, Dot2, Dot3
ValidCharIP$ = "0123456789."

IPAddr$ = LTRIM(RTRIM(IPAddr$))
Length = LEN(IPAddr$)
IF Length < 7 OR Length > 15 THEN EXIT FUNCTION    ' Invalid length detected FOR IP Address. 
FOR Temp = 1 TO Length
  Char1$ = MID(IPAddr$, Temp, 1)
  IF Char1$ = "." THEN
    IF Dot3 THEN EXIT FUNCTION                                                     ' Too many dots.
    IF Dot3 = 0 AND Dot2 > 0 THEN Dot3 = Temp: IF Temp = Length THEN EXIT FUNCTION ' No dot should be at END.
    IF Dot2 = 0 AND Dot1 > 0 THEN Dot2 = Temp
    IF Dot1 = 0 THEN Dot1 = Temp: IF Temp < 2 THEN EXIT FUNCTION   ' No dot should be at the beginning.  
  END IF
  IF INSTR(ValidCharIP$, Char1$) = 0 THEN EXIT FUNCTION  ' Invalid characters detected.
NEXT Temp

IF Dot3 = 0 THEN EXIT FUNCTION                                           ' Not enough dots were detected. (There must always be 3)
IF Dot2 - Dot1 < 2 OR Dot2 - Dot1 > 4 THEN EXIT FUNCTION                 ' Dots should have 1 to 3 digits in between.
IF Dot3 - Dot2 < 2 OR Dot3 - Dot2 > 4 THEN EXIT FUNCTION                 ' Dots should have 1 to 3 digits in between.
IF Length - Dot3 < 1 OR Length - Dot3 > 3 THEN EXIT FUNCTION
Val1 = VAL(LEFT(IPAddr$, Dot1 - 1))                                      ' Tokenizing values from IPaddr$
Val2 = VAL(MID(IPAddr$, Dot1 + 1, Dot2 - Dot1 - 1))
val3 = VAL(MID(IPAddr$, Dot2 + 1, Dot3 - Dot2 - 1))
Val4 = VAL(RIGHT(IPAddr$, Length - Dot3))
IF Val1 > 255 THEN EXIT FUNCTION                             ' Values are out of range. Must be in 0 - 255 range.
IF Val2 > 255 THEN EXIT FUNCTION
IF Val3 > 255 THEN EXIT FUNCTION
IF Val4 > 255 THEN EXIT FUNCTION

ValidIP = -1

END FUNCTION

And now, declare it! Copy the following code and paste it below the "DECLARE FUNCTION Socket_New()" line:

DECLARE FUNCTION ValidIP (BYVAL IPAddr$) AS INTEGER                   ' Detect valid IP address.

So now what? How about grabbing your IP address from a webserver? Let's do it! This will be useful if you're wanting to give your IP address to the user who wants to connect to you. You could also allow the user to give you their IP address as well. Either way, it's nice to know your IP address without having to find out by going into another application.

In this custom routine, you'll be doing a lot of neat stuff, like opening a socket, connecting, sending a request, receiving data, and closing it! Not only that, but the routine is designed to work smoothly without interrupting your main loop for even a split second! This is all possible because you're already polling your sockets! Without it, you would notice pauses through out the program!

Copy the following code and paste the code above the FUNCTION Make_Socket_Accept routine.

FUNCTION GetMyIP$ (BYREF IPState AS INTEGER)

DIM HTTP_PORT AS UINTEGER
DIM HTTP_HOST AS STRING
DIM HTTP_HOST_SCRIPT AS STRING
DIM HTTP_REQUEST AS STRING
DIM ByteReceived AS INTEGER
DIM DataReceived AS STRING
DIM ValidCharIP$, Dot1, Dot2, Dot3

HTTP_PORT = 80                      ' Port 80 is common for HTTP.
HTTP_HOST = "www.marcade.net"       ' Marcade has a website that outputs your IP address.
HTTP_HOST_SCRIPT = "/whatsmyip.php" ' This php script will output your public Ip address.
ValidCharIP$ = "0123456789."        ' This will be used to make sure IP address has valid characters.

' HTTP protocol header stuff to use when trying to communicate with an HTTP web server.
HTTP_REQUEST = "GET " + HTTP_HOST_SCRIPT + " HTTP/1.0" + CHR(13, 10) + "Host: " + HTTP_HOST + CHR(13, 10) + CHR(13, 10)

IF IPState = 0 THEN
  IF Make_Socket_Open(HTTP_Socket) THEN
    IF Make_Socket_Connect(HTTP_Socket, HTTP_HOST, HTTP_PORT) THEN   ' Open + Connect
      IPState = 1
      EXIT FUNCTION
    END IF
  END IF
END IF

IF IPState = 1 THEN                                          ' Request
  Our_Sockets(HTTP_Socket).SendBuffer = HTTP_REQUEST
  IPState = 2
  EXIT FUNCTION
END IF

IF IPState = 2 THEN                                          ' Receive Chunk #1. Most of the data received will contain
  DataReceived = Our_Sockets(HTTP_Socket).RecvBuffer         ' non-essential data for this program. We're just interested
  BytesReceived = LEN(LTRIM(RTRIM(DataReceived)))            ' in grabbing the IP address. The buffer gets 255 bytes at a
  IF BytesReceived > 0 THEN                                  ' time. The total amount of web data is greater than that.
    IPState = 3
    EXIT FUNCTION
  END IF
END IF  

IF IPState = 3 THEN                                          ' Receive Chunk #2, now close the socket. We're done!
  DataReceived = Our_Sockets(HTTP_Socket).RecvBuffer         ' Chunk #2 should contain our IP address in there.
  BytesReceived = LEN(LTRIM(RTRIM(DataReceived)))      
  IF BytesReceived > 0 THEN
    IPState = 4
    Dummy = Make_Socket_Close(HTTP_Socket)                      
      FOR iTemp = LEN(DataReceived) TO 1 STEP -1             ' Since the IP address will be last, we'll go backwards.   
        Char1$ = MID(DataReceived, iTemp, 1)
        IF Char1$ = "." THEN Dot1 += 1                       ' Count our dots and make sure we only have 3.
        IF Dot1 > 3 THEN EXIT FOR                            ' Too many dots.
        IF Dot1 = 3 THEN Dot2 = 1 
        IF INSTR(ValidCharIP$, Char1$) THEN                  ' Extract and verify that it is an IP address!
          AddIP$ = Char1$ + AddIP$                           ' Building our IP address.
        ELSE
          IF Dot2 = 1 THEN EXIT FOR                  ' No more valid characters, and we have 3 dots, so that's it!
        END IF
      NEXT
    IF ValidIP(AddIP$) THEN GrabbedIP$ = AddIP$      ' Use our custom valid IP routine, just to double check!
  END IF
END IF

IF IPState = 4 THEN GetMyIP$ = GrabbedIP$            ' GrabbedIP$ will permanently contain our IP address.

END FUNCTION

And now, declare it! Copy the following code and paste it above the "DECLARE FUNCTION Make_Socket_Accept" line:

DECLARE FUNCTION GetMyIP$ (BYREF IPState AS INTEGER)

And now, copy the following code and paste it below the "LOCATE 1, 25: PRINT "Your version of Winsock is " + WinsockVersion$" line:

  ' Grabbing IP address smoothly in background.
  YourIP$ = GetMyIP$(IPState)
  DummyStringA$ = YourIP$

And now, copy the following code and paste it below the "DIM SHARED DummyStringA$, WinsockVersion$" line:

DIM SHARED YourIP$, GrabbedIP$, IPstate   ' GrabbedIP$ is a buffer for Your attained IP address. IPState indicates progress on getting IP address.

And now, run it! If done correctly, you should see your IP address at the bottom left corner! This is awesome! This means that most of your Winsock routines are running the way they're intended to run! If you don't see your IP address, this is most likely that the web server and script no longer exist. This isn't your fault. This is Marcade's fault for not paying his bills. Anyways, let's go ahead and get rid of some code. Remove the follow code:

DummyStringA$ = STR(Make_Socket_Open(Main_Socket))
DummyStringA$ += STR(Make_Socket_Bind(Main_Socket, PORT))
DummyStringA$ += STR(Make_Socket_Listen(Main_Socket, 0))

Awesome! Now you're going to expand your main loop. The goal is to perform as much operations *inside* the main loop as much as possible. This is so you only make one call to your polling routine. After all, it is nice to keep everything in one loop cycle. With that in mind, you're goint to create loop states, the similar way you did with your socket states. Copy the following code and paste it below the "DIM SHARED Key$, InsertKey" line:

' The status of our loops.
CONST LoopState_Setup_Listening = 0           ' Initiating our loop.
CONST LoopState_Enter_Their_IP = 1            ' Enter their IP address.
CONST LoopState_Retry = 2                     ' Retry connection.
CONST LoopState_Connecting = 3                ' Connecting....
CONST LoopState_Connected_Enter_Your_Name = 4 ' Connected, enter your name.
CONST LoopState_Waiting_Their_Name = 5        ' Waiting on remote user to enter their nick name.
CONST LoopState_Chat = 6                      ' Chatting!
DIM SHARED LoopState AS BYTE                  ' This will be used to check our loop states.

Now, as you can tell, you're about to add an official listening setup routine. This one will be permanent through out the remainder of the program. Keep in mind, you can't connect to a program without being able to listen for a connection. This is why you'll go ahead and make the listening routine. Copy the following code and paste it below the "LOCATE 1, 25: PRINT "Your version of Winsock is " + WinsockVersion$" line:

  ' ========= Initate a listening socket.
  IF LoopState = LoopState_Setup_Listening THEN
    LoopState = LoopState_Enter_Their_IP
    ' Initiate a listening socket.
    IF Make_Socket_Open(Listen_Socket) THEN
      ' Succeeded, opened a socket
      IF Make_Socket_Bind(Listen_Socket, PORT) THEN
		  ' Succeeded; bind socket to port		        ' Succeeded; bind socket to port
        IF Make_Socket_Listen(Listen_Socket, 0) THEN       ' No time out needed.
          Listening = 1                                  ' Succeeded; socket listening for incoming.
        ELSE
          Make_Socket_Close(Listen_Socket)            ' Close it
        END IF
      ELSE
        Make_Socket_Close(Listen_Socket)            ' Mostly likey, port is already used by our first instance. This is normal.
      END IF
    ELSE
      PrintErrorEND "Unable to open socket!"
    END IF
  END IF

As you can see in the above code, you now have a socket that is listening. You also have changed the loop state to "LoopState_Enter_Their_IP". This means later on, you'll create a routine where you'll enter the remote user's IP address! For inputting text, you could use INPUT, however, INPUT halts the entire program until you hit ENTER. Obviously, this will not work for a program designed to be constantly looping at all times. Since your sockets need polling, you need it to constantly loop without interruptions! In this case, you'll create a custom input!

Unlike FB's INPUT, this custom input routine will allow the use of the insert key, limit the amount of characters to enter, and most of all, it runs in the background without ever halting the program! Copy the following code and paste it below the "Winsock_Close" line:

SUB CustomInput (Text$, MaxLength, KeyChar$, CursorPosition)

/'
  This is your custom INPUT. Unlike INPUT, You can run this one
  in the looping background. You can still edit text by adding
  a character, inserting a character, backspacing, deleting, and
  change the cursor position with left/right arrow keys, Home,
  and End. You can also limit the character length of your input
  string. 
'/

' Modify STRING
Length = LEN(Text$)
IF CursorPosition > Length THEN CursorPosition = Length
SELECT CASE KeyChar$
  CASE CHR(8)  ' Backspace
    IF Length AND CursorPosition > 0 THEN
      CursorPosition = CursorPosition - 1
      AAL$ = LEFT(Text$, CursorPosition)
      AAR$ = RIGHT(Text$, Length - CursorPosition - 1)
      Text$ = AAL$ + AAR$
    END IF
  CASE CHR(255) + CHR(71) ' Home key
    CursorPosition = 0
  CASE CHR(255) + CHR(75) ' Left key
    CursorPosition = CursorPosition + (CursorPosition > 0)
  CASE CHR(255) + CHR(77) ' Right key
    CursorPosition = CursorPosition - (CursorPosition < Length)
  CASE CHR(255) + CHR(79) ' End key
    CursorPosition = Length
  CASE CHR(255) + CHR(83) ' Delete key
    IF CursorPosition < Length THEN
      AAL$ = LEFT(Text$, CursorPosition)
      AAR$ = RIGHT(Text$, LEN(Text$) - CursorPosition - 1)
      Text$ = AAL$ + AAR$
    END IF
END SELECT

' Add to text STRING
IF LEN(KeyChar$) = 1 THEN  ' Make sure character length is 1.
  IF ASC(KeyChar$) > 31 AND CursorPosition < MaxLength THEN
    IF InsertKey THEN                      ' Insert character and replace.
      IF CursorPosition < Length THEN MID$(Text$, CursorPosition + 1, 1) = KeyChar$
      IF CursorPosition = Length THEN Text$ += KeyChar$
      CursorPosition = CursorPosition + 1
    ELSE
      IF MaxLength > LEN(Text$) THEN       ' Insert and move text to right.
        AAL$ = LEFT(Text$, CursorPosition)
        AAR$ = RIGHT(Text$, Length - CursorPosition)
        Text$ = LEFT(AAL$ + KeyChar$ + AAR$, MaxLength)
        CursorPosition = CursorPosition + 1
      END IF
    END IF
  END IF
END IF

END SUB

This will be very nice to have later on! You'll be using it for entering text for a few things! And now, you'll need to declare it. Copy the following code and paste it above the "DECLARE SUB PrintErrorEnd (ErrorMessage$)" line:

DECLARE SUB CustomInput (Text$, MaxLength, KeyChar$, CursorPosition)  ' Custom INPUT that works in background!

Since you're customizing routines, let's go ahead and make a custom sending data routine by shortening it, and making it pass only one parameter. This will make the workflow go by faster and easier to read. Copy the following code and paste it above the FUNCTION Socket_New routine:

SUB SendThis (stAction AS STRING)

' Add to our send buffer!
Our_Sockets(Main_Socket).SendBuffer = Our_Sockets(Main_Socket).SendBuffer + stAction + CHR(1)

END SUB

And now, declare it. Copy the following code and paste it below the "DECLARE SUB PrintErrorEnd (ErrorMessage$)" line:

DECLARE SUB SendThis (stAction AS STRING)                             ' Shortened wrapper for sending data.

In the next part, you'll be entering a user's IP address. With the custom input routine, you would need an input string, and the input cursor position for it. Copy the following code and paste it below the "DIM SHARED YourIP$, GrabbedIP$, IPstate" line:

DIM SHARED TheirIP$, TheirIPCursor        ' This is for entering their IP address.

Now is the time to create a routine for you to enter the remote user's IP address. This will be needed when trying to connect to the other user. A lot of things will happen here, so be sure to write this down in your notes. Keep in mind, when you're connecting with the make_socket_connect routine, all it really does is send out a connection request. You'll need it to somehow tell it "hello." In fact, you'll do exactly just that! You'll send out a "hello." string to the listening remote user!

Copy the following code and paste it above the "' Grabbing IP address smoothly in background." line, where you had your "YourIP$ = GetMyIP$(IPState)":

  ' ========= Start up screen.
  IF LoopState = LoopState_Enter_Their_IP THEN

    LOCATE 16, 5: PRINT "Your IP address: " + YourIP$
    IF Listening THEN
      LOCATE 3, 5: PRINT "You can enter their IP address or wait for them to connect to you!"
      COLOR 11: LOCATE 8, 5: PRINT "Listening is enabled."
    ELSE
      LOCATE 3, 5: PRINT "You'll have to type in the IP address since listening is disabled."
      COLOR 12: LOCATE 8, 5: PRINT "Listening is disabled."
    END IF ' Listening

    CustomInput TheirIP$, 15, Key$, TheirIPCursor ' Input text and print it out.
    COLOR 15
    LOCATE 5, 5: PRINT TheirIP$
    IF FrameAnimate AND 32 THEN
      LOCATE 5, 5 + TheirIPCursor
      IF InsertKey THEN PRINT CHR(219) ELSE PRINT "_"
    END IF ' FrameAnimate

    IF ValidIP(TheirIP$) THEN
    
      ' User hits ENTER, let's fire up a socket!
      IF Key$ = CHR(13) THEN 
        IF Make_Socket_Open(Main_Socket) THEN    ' Close down listening socket if we're connecting.
          IF Our_Sockets(Listen_Socket).State = Socket_Is_Listening THEN
            IF Make_Socket_Close(Listen_Socket) = 0 THEN
              PrintErrorEND "Error in closing the listening socket!"
	    END IF ' close socket
	  END IF ' status listening
	  IF Make_Socket_Connect(Main_Socket, TheirIP$, PORT) THEN

	    SendThis "Hello."  ' This is the connection request, or hand-shake, as some would say.

            LoopState = LoopState_Connecting
          ELSE
	    PrintErrorEND "Error in connecting routine!"
          END IF ' connect
        ELSE
          PrintErrorEND "Error in opening our main socket!"
        END IF ' open socket
      END IF ' enter key
      COLOR 10: LOCATE 12, 5: PRINT "Valid IP address has been typed! Hit ENTER to initiate connection!"
      COLOR 15
    ELSE ' Still waiting for valid IP
      COLOR 12: LOCATE 12, 5: PRINT "Please type a valid IP address!  Example: x.x.x.x  x = 0 to 255."
      COLOR 15
    END IF  ' End waiting on valid IP
  END IF  ' End of our start screen.

You may now run it! You'll be able to test out the custom input routine! Type out a dotted IP address and see if it validates it instantly. Don't hit enter right away, we're not that far yet. After this, let's make an official connecting routine. This time, you'll make a "connecting..." animation screen. Copy the following code and paste it below the entire "Enter your IP" routine you've recently pasted:

  ' We're still connecting...
  IF Our_Sockets(Main_Socket).State = Socket_Is_Connecting THEN 
    LoopState = LoopState_Connecting
    LOCATE 15, 5: PRINT "Connecting"
    LOCATE 15, 15: PRINT STRING(FrameAnimate SHR 2, ".")
  END IF

The entire code so far: winsock_code4.txt

Now run it again! You may also enter an IP address and hit enter. It should say it's "connecting..." at this point. It will not establish a connection right away til you acknowledge the "Hello." string. Let's go ahead and do that! Copy the following code and paste it above the entire "' ========= Initate a listening socket." routine that you've recently pasted:

  ' Check all available sockets for incoming connection:
  IF HTTP_Socket = 0 THEN                                    ' Once we got our IP address, let's open a listening socket.
    FOR Check_This_Socket = 1 TO UBOUND(Our_Sockets)
      IF Our_Sockets(Check_This_Socket).State = Socket_Is_Connected OR Our_Sockets(Check_This_Socket).State = Socket_Is_Closing THEN
        IF LEN(Our_Sockets(Check_This_Socket).RecvBuffer) > 0 THEN 

          ' Received our "Hello" from other instance.

          IF LoopState = LoopState_Enter_Their_IP AND LEFT(Our_Sockets(Check_This_Socket).RecvBuffer, 6) = "Hello." THEN
            Our_Sockets(Check_This_Socket).RecvBuffer = MID(Our_Sockets(Check_This_Socket).RecvBuffer, 7) ' Increment our buffer
            Main_Socket = Check_This_Socket   ' Our listening socket now becomes our main socket.
          END IF
  	END IF
      END IF
    NEXT Check_This_Socket
  END IF

You're almost done with this connecting routine! Now that you've acknowledged the "Hello.", you've made the Main_Socket an active socket for your chat program! This means that you're officially connected! Do you remember that "Hello." string you sent out? You acknowledged it! Your SUB Poll_Our_Sockets routine, which contained the "Make_Socket_Accept" call has accepted the connection and allowed your receiving buffer to work, so you can receive the "Hello." string!

Even though the listening user is connected, the listening user still needs to have its loop state changed. Copy the following code and paste it below the entire "We're still connecting" routine that you've recently pasted:

  ' We're connected? What? Ok! Now let's tell that to our main loop!
  IF Our_Sockets(Main_Socket).State = Socket_Is_Connected THEN
    IF LoopState < LoopState_Connected_Enter_Your_Name THEN
      LoopState = LoopState_Connected_Enter_Your_Name 
    END IF
  END IF

Guess what? It's time to test out two instances of your program! That's right, from this point, you will test out two instances of your program! Go ahead and run two instances of them. Since FBedit only launches one instance, you'll need to find some way to execute the second one. The trick I use, is to have a shortcut copy of the EXE on my desktop, or have your shortcut EXE launched from your taskbar. This will make the workflow go by much faster, as you're constantly testing out two instances.

After you've launched two instances, you'll notice only one of the instances is listening. This means that the first one you've launched is the one listening. The second instance will not listen, because the PORT number is already being used by your first instance. This is a good thing, because that means your two instances can connect to each other! Next, you'll go to your non-listening (the second instance) and type in "127.0.0.1" and hit enter. If you have the two windows next to each other, you'll notice they will both go into a black screen! This is excellent!

Now you're connected! So now what? Let's get the users to exchange their nick names! Let's make a routine where you enter your nick name! Copy the following code and paste it below the entire "'We're connected?" routine that you've recently pasted:

  ' ========  We're connected, now enter nick name!
  IF LoopState = LoopState_Connected_Enter_Your_Name THEN
    IF Key$ = CHR(13) THEN
      IF LEN(LTRIM(RTRIM(YourName$))) THEN
        LoopState = LoopState_Waiting_Their_Name  
        SendThis YourName$               ' Send it to them.
      END IF 
    END IF
    LOCATE 11, 30: PRINT "CONNECTED! YES!"
    CustomInput YourName$, 10, Key$, YourNameCursor
    LOCATE 13, 20: PRINT "Now enter your nick name: (10 Chars Max)"
    LOCATE 15, 20: PRINT YourName$
    IF FrameAnimate AND 32 THEN
      LOCATE 15, 20 + YourNameCursor
      IF InsertKey THEN PRINT CHR(219) ELSE PRINT "_"
    END IF
  END IF

And now, as you can see, you need some variables for your name and the cursor. Copy the following code and paste it below the "DIM SHARED TheirIP$, TheirIPCursor" line:

DIM SHARED YourName$, YourNameCursor              ' This is for entering your nick name.

You can run it, however, that's the only change. Now you need to wait on the user to enter their nick name. Let's add that! Copy the following code and paste it below the entire "now enter nick name!" routine that you've recently pasted:

  ' ======== Waiting for them to enter their nick name!
  IF LoopState = LoopState_Waiting_Their_Name THEN
    LOCATE 15, 15: PRINT "Waiting on remote user to enter their nick name..."
    IF LEN(TheirName$) THEN LoopState = LoopState_Chat
  END IF

This is good and all, but what happens if the remote user entered their name before the local user entered their name? That means you'll also need a routine that accepts the remote user's nick name! Copy the following code and paste it above the entire "' ========= Initate a listening socket." routine:

' Received remote user's nick name.
  IF LEN(TheirName$) = 0 THEN 
    IF INSTR(Our_Sockets(Main_Socket).RecvBuffer, CHR(1)) > 0 THEN
      ' Handshake. Hi other user
      TheirName$ = LEFT(Our_Sockets(Main_Socket).RecvBuffer, INSTR(Our_Sockets(Main_Socket).RecvBuffer, CHR(1)) - 1)
      Our_Sockets(Main_Socket).RecvBuffer = MID(Our_Sockets(Main_Socket).RecvBuffer, INSTR(Our_Sockets(Main_Socket).RecvBuffer, CHR(1)) + 1)
    END IF
  END IF

Great, now copy the following code and paste it below the "DIM SHARED YourName$, YourNameCursor" line:

DIM SHARED TheirName$                             ' Remote user's nick name.

Great! You may run two instances of this. You'll see that once both users enter their name, both windows will go black at the same time. This is when you'll need to call for a chat routine! Yes, it's finally here! You'll make a chat routine! First, let's make a fancy text-box routine. This will make things look more eye-pleasing. Copy the following code and paste it above the FUNCTION Poll_Our_Sockets routine:

SUB MakeBox (Row1, Col1, Row2, Col2) 

DIM RowDist, ColDist

' Swap coordinates that are greater.
IF Row1 > Row2 THEN SWAP Row1, Row2
IF Col1 > Col2 THEN SWAP Col1, Col2

' Box isn't big enough
RowDist = (Row2 - Row1) - 1
ColDist = (Col2 - Col1) - 1
IF RowDist <= 0 THEN EXIT SUB
IF ColDist <= 0 THEN EXIT SUB

' Top part
LOCATE Row1, Col1: PRINT CHR(201) + STRING(ColDist, CHR(205)) + CHR(187)
FOR iRow = (Row1 + 1) TO (Row2 - 1)
  LOCATE iRow, Col1: PRINT CHR(186)
  LOCATE iRow, Col2: PRINT CHR(186)
NEXT
LOCATE Row2, Col1: PRINT CHR(200) + STRING(ColDist, CHR(205)) + CHR(188)

END SUB

And now, declare it! Copy the following code and paste it above the "DECLARE SUB PrintErrorEnd (ErrorMessage$)" line:

DECLARE SUB MakeBox (Row1, Col1, Row2, Col2)                          ' Make a text box

Let's give it a quick test! Copy the follow code and paste it above the "LOCATE 16, 5: PRINT "Your IP address: " + YourIP$" line:

MakeBox 15, 3, 17, 40

Did it make a box? Good! This will look good for the chat box! Even though you haven't started on the chat room code, you'll need to make a couple of custom routines. Let's go ahead and get those knocked out! Let's make a routine that whenever a chat message has been sent (or received), it updates the chat box by scrolling it up. Copy the follow code and paste it above the SUB CustomInput routine:

SUB AddMessage (stMessage AS STRING)

' Message history being updated.
FOR I = 0 TO 14
  Messages(I) = Messages(I + 1)
NEXT
Messages(15) = stMessage

END SUB

And now, declare it! Copy the following code and paste it above the "DECLARE SUB CustomInput" line:

DECLARE SUB AddMessage (stMessage AS STRING)                          ' Add message to our screen.

And now, you need to define your messages array. Copy the following code and paste it above the "DIM SHARED DummyStringA$, WinsockVersion$" line:

DIM SHARED Messages(0 TO 15) AS STRING        ' Message

You're getting there! Now it's time to make the chat box screen! Let's explain a couple of things that will happen before continuing: 1) When receiving, you'll want the text to go directly to the window with the AddMessage routine. 2) When you send a text, you'll want to send the text to both your SendThis routine and your AddMessage routine. This will make both windows look syncronized with one exception: You'll want to change the chat text colors to differentiate from the other user's colors, so that you can spot your text a lot faster! Without wasting any more of your time, go ahead and copy the following code and paste it below the entire "Waiting for them to enter" routine:

' ======== Ah, finally, let's chat, damn it!
  IF LoopState = LoopState_Chat THEN
    ' Display our message history!
    FOR I = 0 TO 15
      IF LEFT(Messages(I), 2) = "R:" THEN ' Remote user
        COLOR 9
        LOCATE I + 4, 5: PRINT TheirName$ + ": " + MID(Messages(I), 3)
      END IF
      IF LEFT(Messages(I), 2) = "L:" THEN ' Local user
        COLOR 12
        LOCATE I + 4, 5: PRINT YourName$ + ": " + MID(Messages(I), 3)
      END IF
    NEXT
    COLOR 15
    LOCATE 25, 5: PRINT "Type your text and hit ENTER to send the message."
    CustomInput ChatInputText$, 60, Key$, ChatInputTextCursor
    ' Send our text now!
    IF Key$ = CHR(13) THEN           ' Enter to send text.
      IF LEN(ChatInputText$) THEN
        AddMessage "L:" + ChatInputText$ ' Local window gets message.
        SendThis "R:" + ChatInputText$   ' Remote window gets message.
        ChatInputText$ = ""
      END IF
    END IF
    LOCATE 22, 17: PRINT ChatInputText$
    IF FrameAnimate AND 32 THEN
      LOCATE 22, 17 + ChatInputTextCursor
      IF InsertKey THEN PRINT CHR(219) ELSE PRINT "_"
    END IF ' FrameAnimate
    MakeBox 3, 3, 20, 78
    MakeBox 21, 15, 23, 78
  END IF

And let's define your chat input variables. Copy the following code and paste it below the "DIM SHARED TheirName$" line:

DIM SHARED ChatInputText$, ChatInputTextCursor    ' This is for chatting input.

The entire code so far: winsock_code5.txt

Yay! Go ahead and run it. At this point, you should be able to see a chat window, enter some chat text, and watch it update in the chat box. Even with all that being done, it will not update on the remote user's chat box just yet. With that being mentioned, let's make it happen by making a routine that processes the remote user's actions! If you've ever thought about making a game where you need to process the incoming data, then this is where you would put it!

Copy the following code and paste it above the SUB PrintErrorEND (ErrorMessage$) routine:

SUB Process_Remote_Data

DIM ParseThis AS STRING  ' The string to extract.
DIM stCommand AS STRING     ' Custom command.
DIM stValue AS STRING    ' Custom value.
DIM EndString AS INTEGER ' The end position of the string.
DIM Colon AS INTEGER     ' Colon contained in our received data.

GoBackForMore:
EndString = INSTR(Our_Sockets(Main_Socket).RecvBuffer, CHR(1)) - 1 ' Get the length/end position of the string.
IF EndString <= 0 THEN EXIT SUB

ParseThis = LEFT(Our_Sockets(Main_Socket).RecvBuffer, EndString): ParseThis = LTRIM(RTRIM(ParseThis))  ' Clean up stAction and make a copy.
IF ParseThis = "" THEN EXIT SUB
Colon = INSTR(ParseThis, ":")

' Colon has to be present.
IF Colon THEN
  stCommand = LEFT(ParseThis, Colon - 1) ' Left most stuff, these will be our custom commands.
  stValue = MID(ParseThis, Colon + 1)    ' Right most stuff, these will be our command values.
ELSE
  EXIT SUB
END IF

' Remote user has sent us something.
SELECT CASE stCommand
  CASE "R" ' The Remote User sends a message
    stValue = LTRIM(RTRIM(stValue))
    AddMessage "R:" + stValue       ' Add message to local window.
    ParseThis = ""
END SELECT

Our_Sockets(Main_Socket).RecvBuffer = MID(Our_Sockets(Main_Socket).RecvBuffer, EndString + 2) '  + 2 to offset from CHR(0) on the right side.
GOTO GoBackForMore     ' This is assuming we have more receiving data pending before the next loop cycle.

END SUB

Just a note, when sending data, you're basically sending three things: The first is a custom command. The second is a separator (In our case, a colon) which separates the command and value. The Third is the value. This is basically saying, "Hey, I want to send a text" and then you put a colon ":" in between the text message, and then send the text message. The same thing is happening with the "R" command you see in the SELECT CASE block. The custom command "R" (Short for REMOTE) is basically telling the receiving end that it's a text message from the sender.

Also, if you're ever receiving more data than intended, it's a good idea to have it go back until it's done processing all the data. This is why you're seeing a "GoBackForMore:" line label in the code. Before we continue, let's declare the SUB. Copy the following code and paste it below the "DECLARE SUB PrintErrorEND (ErrorMessage$)" line:

DECLARE SUB Process_Remote_Data ()                                    ' What to do with our received data!

And one thing to copy and paste. Copy the following code and paste it above the "' Grabbing IP address smoothly in background." line:

  ' What to do with our received data.
  Process_Remote_Data

Now run it! You should be seeing text messages up to sync on both windows! This is awesome! You've successfully made a chat program! Even so, let's make one more routine. When one of the users terminates their program, wouldn't it be nice if the other user is informed? Let's make it where the other user gets the "bye" message that the user terminated his or her connection. Copy the following code and paste it below the "LOOP UNTIL Key$ = CHR(27)" line:

' Tell our connected user goodbye!
IF Our_Sockets(Main_Socket).State = Socket_Is_Connected THEN SendThis "BYE:"
Polling = Poll_Our_Sockets

' For some reason, some delay is needed, so the remote user gets the goodbye message.
SLEEP 100

And let's go back the SUB Process_Remote_Data routine. Copy the following code and paste it below the "SELECT CASE stCommand" line:

  CASE "BYE"
    Our_Sockets(Main_Socket).State = Socket_Is_Closing
    LoopState = LoopState_Retry
    TheirName$ = ""

And you're almost done! Let's make a routine that shows the user has disconnected! This will definitely be needed if you plan on informing the user that the remote user ended their connection! Copy the following code and paste it above the connected routine in your main loop:

  ' An established connection has been terminated.
  IF LoopState = LoopState_Retry THEN
    COLOR 12
    LOCATE 13, 25: PRINT "Connection has terminated!"
    LOCATE 15, 25: PRINT "Hit ENTER to retry or ESC to quit."
    IF Key$ = CHR(13) THEN LoopState = LoopState_Enter_Their_IP
    COLOR 15
  END IF

Run it! Now your user tells you "bye" and it prompts you that they disconnected! That's it! You are officially done! Give yourself a huge applause! You've made a chat program with a lot of patience! Imagine how much time it has taken us to make this tutorial! Now go make your network game or program! Peace!

The final code written in -fblite dialect (original): winsock_code6.txt

The final code in -fb dialect (~ Ed): winsock_code6fb.txt

A Simple Platform Game

Written by Justin Richards, edited for the tutorial by Lachie Dazdarian (July, 2012)

Introduction

This is a tutorial edit of Justin Richards' educative mini-platform game example code. I tried to format and edit the code so it can serve as a tutorial. The run the WIP code through-out the tutorial you'll need the following resource files: Resources.zip.

The Tutorial

In the beginning we will declare some keyboard constants, as well as a user defined type and memory buffers where we will store all the game graphics. The following code uses a custom made image file format to load the graphics from, and I will provide later a program that allows you to create and save images in that format. Just have in mind that the way you load graphics and where from is irrelevant to the topic of this tutorial. Let's go:

' Keyboard Capture Code...

' The following codes refer to the machine code for each key on the keyboard.
' By storing these codes into appropriately named constant variables we can
' easily test them without confusion.

CONST Key_Up& = 18432
CONST Key_Down& = 20480
CONST Key_Left& = 19200
CONST Key_Right& = 19712
CONST Key_Space& = 32
CONST Key_Enter& = 13
CONST Key_Ctrl& = 100306
CONST Key_Shift& = 100304
CONST Key_KP_Zero& = 48


' Define a Graphics Type to use when reading records from the .gfx
' files we import.  This is optional, you could just draw the graphics
' in game using LINE, CIRLCE and PAINT, etc commands instead, however
' in larger more complex games this will greatly increase the lines of
' code required and extend compile times.

TYPE GraphicsType '   Always be descriptive with User Defined Type Names

  PX AS STRING * 2 '  Pixel X Co-ordinate
  PY AS STRING * 2 '  Pixel Y Co-ordinate
  PCO AS STRING * 3 ' Pixel Colour Value

END TYPE


' One Image Record (consisting of a value for PX, PY, and PCO) will have a
' length of SEVEN.  This value will be assigned to the variable GTIncrement
' and will be used to read the graphics file records sequentially later.

DIM SHARED GTIncrement
DIM SHARED GT AS GraphicsType

' GT is how we refer to our User Defined Type when opening our files

' Use "SHARED" when dimensioning variables if you plan on having multiple
' SUBS which will test for that value.  It is a lot less confusing
' when calling SUBS and will allow for less human error.



' Dimension variable arrays for our graphics.  Use a descriptive name for
' example, if the graphic is a Man facing Left then "ManL" would be a good
' name.  You can clearly tell what the graphic will be by the name.
' The Number in brackets beside the name refers to how much memory the graphic
' will require.  Below is a reference for the graphics used in this game...

' 10 x 10 pixels = (51)
' 20 x 20 pixels = (201)
' 30 x 30 pixels = (451)
' 40 x 40 pixels = (801)

' The formula is as follows - Width x Height (in pixels) / 2 + 1
' Use this formula rather than guessing the numbers.  Having large numbers
' in excess of what is required will waste memory.

' These are the Graphic Arrays for our Character. There are 22 frames in
' total.  This is just an example, you could quite easily use more or less
' frames in your own animations.

DIM SHARED ManL(801) AS INTEGER '      Standing, Walking and Crouching
DIM SHARED ManLStep(801) AS INTEGER
DIM SHARED ManLCrouch(801) AS INTEGER
DIM SHARED ManLfi8(801) AS INTEGER '   Firing the Shotgun
DIM SHARED ManLfi7(801) AS INTEGER
DIM SHARED ManLfi6(801) AS INTEGER
DIM SHARED ManLfi5(801) AS INTEGER
DIM SHARED ManLCfi8(801) AS INTEGER '  Firing while crouching
DIM SHARED ManLCfi7(801) AS INTEGER
DIM SHARED ManLCfi6(801) AS INTEGER
DIM SHARED ManLCfi5(801) AS INTEGER

DIM SHARED ManR(801) AS INTEGER '      These are the same but facing right
DIM SHARED ManRStep(801) AS INTEGER
DIM SHARED ManRCrouch(801) AS INTEGER
DIM SHARED ManRfi8(801) AS INTEGER
DIM SHARED ManRfi7(801) AS INTEGER
DIM SHARED ManRfi6(801) AS INTEGER
DIM SHARED ManRfi5(801) AS INTEGER
DIM SHARED ManRCfi8(801) AS INTEGER
DIM SHARED ManRCfi7(801) AS INTEGER
DIM SHARED ManRCfi6(801) AS INTEGER
DIM SHARED ManRCfi5(801) AS INTEGER


' The door has a closed and open state, comprised of three images

DIM SHARED DoorBottom(801) AS INTEGER
DIM SHARED DoorTop(51) AS INTEGER
DIM SHARED DoorOpen(51) AS INTEGER



' Grass is a Decal Image used to make the floors look more interesting.

DIM SHARED Grass(201) AS INTEGER

' The Droid is going to move around the screen switching from left to right.

DIM SHARED DroidLeft(201) AS INTEGER
DIM SHARED DroidRight(201) AS INTEGER

' Crates will be placed on the screen for effect.

DIM SHARED CrateWood(451) AS INTEGER

' These Rock Decals will be placed as foreground objects.

DIM SHARED RockDecalBottom(451) AS INTEGER
DIM SHARED RockDecalBottom1(451) AS INTEGER
DIM SHARED RockDecalTop(451) AS INTEGER
DIM SHARED RockDecalTop1(451) AS INTEGER

' These hearts form the health meter in the HUD.

DIM SHARED SmallHeart(201) AS INTEGER
DIM SHARED SmallHeart1(201) AS INTEGER

DIM SHARED HalfHeart(201) AS INTEGER
DIM SHARED HalfHeart1(201) AS INTEGER

Let's now declare the subroutines we'll use in our program. We'll go through each and every one in more detail step by step.

' The Get Images SUB routine will capture our images and store them in the
' image arrays we defined earlier.

DECLARE SUB GetImages


' The DrawImages SUB routine will be used to draw graphics onto the screen at
' different points during the game loop.  The DrawWhat variable will define
' what to draw when the routine is called.  It has been Dimensioned as a
' STRING so we can clearly see what to draw.  It's values are as follows:

' "BackGround"     - Draw the Background Tiles Only
' "FixedSprites"   - Draw things that are fixed in position but not background objects
' "MovingSprites"  - Draw Enemies and other items that change position
' "ForeGround"     - Draw Decals in front of everything else

DECLARE SUB DrawImages
DIM SHARED DrawWhat AS STRING


' This SUB routine draws the Heads Up Display

DECLARE SUB Hud

Let's now declare all the remaining variables that will be used in our program.

' GameTimer is a variable used to control fast animations.  In our example it
' will range from -16 to 16 but could be altered to suit your needs.

DIM SHARED GameTimer


' TimeCount measures One Second Delays.  Our example will increment until it
' reaches 4 and then reset to 0.

DIM SHARED TimeCount


' Secs (Seconds) and Mins (Minutes) will be used to make our level timer.

DIM SHARED Secs, Mins


' The DrawMan SUB routine will draw the man :| .  All Man variables are
' pre-fixed with with "Mn" so that we can tell them apart from other variables.

DECLARE SUB DrawMan
DIM SHARED MnX, MnY, MnSide ' X and Y Position and the direction he is facing
DIM SHARED MnWalkOn, MnWalkTimer, MnCrouchOn, MnJumpOn ' Movement Status
DIM SHARED MnFireTimer, MnFireOn ' Firing Status.
DIM SHARED MnHealth, MnAmmo ' Health and Ammunition Status Variables


' Every object in the game (excluding the man) will be loaded in the form of
' a tile.
' Each Tile has several properties which will tell our DrawImages SUB routine
' how to draw the tile and also which tiles can be interacted with by the
' player.  There are currently 30 tiles per screen, this can be modified.

DIM SHARED TileType(30)
DIM SHARED TileProperty1(30)
DIM SHARED TileProperty2(30)
DIM SHARED TileColour1(30)
DIM SHARED TileColour2(30)
DIM SHARED TileX1(30)
DIM SHARED TileY1(30)
DIM SHARED TileX2(30)
DIM SHARED TileY2(30)


' Always include an Error Handler in your programs even if it does just end
' the program.  That's far better than it catching an exception and scaring
' the user into thinking they have crashed their machine.

ON ERROR GOTO Errors

Let's now define the "reset variables" part of our code, meaning, a place where all our key variables will be reset before each new game, so to speak. It's always important to reset your variables before you initiate the main game loop, not only when you start the program. A common mistake among novice programmers is only to set the variables on the beginning on the program and not on the place where the main game loop is initiated ("NEW GAME" option, for example).

Start:


' Set up Game Variables

' Health

MnHealth = 290 '      315 = dead / 275 = full, increment -5 for half a heart

' Ammunition

MnAmmo = 60 '         90 = full / 0 = empty, increment 3 for one shell

' Timers

GameTimer = -1 ' GameTimer can never equal zero or the animations will freeze
TimeCount = 1


' Reset all 30 tiles to -1 values (don't exist) before we modify them.

FOR ResetTile = 0 TO 29
  TileType(ResetTile) = -1
  TileProperty1(ResetTile) = -1
  TileProperty2(ResetTile) = -1
  TileColour1(ResetTile) = -1
  TileColour2(ResetTile) = -1
  TileX1(ResetTile) = -1
  TileY1(ResetTile) = -1
  TileX2(ResetTile) = -1
  TileY2(ResetTile) = -1
NEXT ResetTile


' Place our Man into the level and give him health and ammunition

MnX = 60
MnY = 50
MnSide = 1
MnHealth = 270
MnAmmo = 60


' Set OrigTime$ Variable to the current system time (TIME$).

OrigTime$ = TIME$


' The following variable TimeSet will determine how fast the game runs.  Play
' around with it and see what happens.

TimeSet = 1


' Reset this variable to 0.  It needs to equal TimeSet in order for the game
' loop to process.  It will be incremented by 1 at the end of the main game
' loop.

GameSpeed = 0

Now, the skeleton of our main game loop:

DO


  ' Clear a space in memory to store the timer ticks using DEF SEG.

  DEF SEG = 0


  ' Reset the Timer Tick to 0 using POKE.

  POKE 1132, 0


  ' If the desired delay has passed then process the main game loop...

  IF GameSpeed = TimeSet THEN


    ' Clear the Keyboard buffer and end game if escape key is pressed

    FOR KbdLoop = 0 TO 32 ' The buffer remembers only 32 keystrokes.

      Kbd$ = "" '           Reset Kbd$ to nothing so that it can be reused.

      ' By setting Kbd$ to INKEY$ we take one keystroke away from the keyboard
      ' buffer, once we have done this 32 times the buffer will be empty.

      Kbd$ = INKEY$

      IF Kbd$ = CHR$(27) THEN ' CHR$(27) is the character code for 'Escape'

        ' Clear the screen then display the blank screen, pause for a moment
        ' and disable full screen mode, then return to the OS.

        CLS

        _DISPLAY

        SLEEP 1

        _FULLSCREEN _OFF

        SYSTEM

      END IF

    NEXT KbdLoop


    ' Increment the GameTimer Variable

    IF GameTimer > 0 THEN GameTimer = GameTimer + 1
    IF GameTimer < 0 THEN GameTimer = GameTimer - 1


    ' Reset the GameTimer Variable if it gets to large.  16 works quite well
    ' but can be changed to suit longer or shorter animation requirements.

    IF GameTimer < -16 THEN

      GameTimer = 1

    ELSEIF GameTimer > 16 THEN

      GameTimer = -1

    END IF


    ' Increment TimeCount if one second has passed and calculate the seconds
    ' and minutes that have passed since beginning the game.  Note that if the
    ' time goes passed midnight it will reset to 0:00:00 and the calculations
    ' wont work which will stop the animations also.  There is a fix for this,
    ' it's so infrequent that I never bothered with it.

    IF TIME$ > OrigTime$ THEN

      TimeCount = TimeCount + 1


      ' Reset OrigTime so we can wait for another second to pass

      OrigTime$ = TIME$


      ' If we reach 10 minutes then stop counting...

      IF NOT (Mins = 9 AND Secs = 59) THEN Secs = Secs + 1


      ' After a minute, reset seconds to zero and increment minutes by one.

      IF Secs = 60 THEN

        Secs = 0
        Mins = Mins + 1

      END IF

    END IF

		
    ' TimeCount can be reset at any stage, but in this example we will use 4.
    ' 4 means you can have 4 one second animations (eg an item spinning around
    ' using 4 animations will end up back where it started when we reset
    ' TimeCount).

    IF TimeCount = 4 THEN

      OrigTime$ = TIME$
      TimeCount = 0

    END IF	


    ' Reset this variable in order to maintain a constant game speed.  If you
    ' don't the game will display once and then freeze :(

    GameSpeed = 0


    ' Having the _DISPLAY command inside a loop disables the auto display
    ' which happens as standard.  This means that nothing that we have drawn
    ' onto the screen has been displayed so far, its all been drawn into
    ' memory, ready to be copied to the screen once the loop reaches this
    ' command.

    _DISPLAY

  END IF


  ' Once we have completed one cycle of the main game loop we must then pause
  ' until the clock ticks have reached aproximately 1/18th of a second since
  ' we started the loop (this is how we maintain the speed, we are testing
  ' an external time source instead of variables within the game).

  DO

    '  Delay for 1/18th of a second

  LOOP UNTIL PEEK(1132) >= 1

  DEF SEG ' reset segment to default


  ' GameSpeed is incremented and then tested at the beginning of the loop.

  GameSpeed = GameSpeed + 1


LOOP



Errors:

' Using SYSTEM instead of END will return the user to the OS without having to
' press any key to continue.

SYSTEM

It contains rather self-explanatory timing routines that will become more clear later, plus a simple minutes and seconds counter.

We will declare now our GetImages sub under the main loop that will set the screen resolution and load all the game graphics:

SUB GetImages

' This SUB routine converts the .gfx (text) files into images and stores them
' into easily called upon variable arrays.


' Set the screen dimensions and colours.  the ", , 1, 0" uses screen page 1
' instead of the default 0 meaning we will not see any drawing on the screen
' until we switch screen pages.  This looks much more professional than having
' a bunch of images flash up on the screen and disappear suddenly.

' In this example we are using a screen mode identical to the old Qbasic
' Screen Mode 13.  320 pixels wide x 200 pixels high and with 256 colours. The
' difference is that we can use a screen page in QB64 where that was not
' possible in the original Qbasic program.

SCREEN _NEWIMAGE(320, 200, 256), , 1, 0


' This sets the window to full screen mode, comment out if you prefer a
' normal window instead.

_FULLSCREEN


' This part of the SUB opens each individual Image file one by one, draws it
' on the screen, then captures it and stores it as a variable array. Broken
' down it works like this...

Below that, each graphics file is opened as BINARY, a part of the code that extracts the data from it is invoked (GetLoop label), the pixels are placed on the screen, and after that the image is captured by a GET statement and stored in the appropriate memory buffer.

' Open the File we need located in the Resources Directory and read each
' record using the length defined by GT.

OPEN "Resources\ManL.gfx" FOR BINARY AS 1 LEN = LEN(GT)

' Run the GetLoop GOSUB procedure to read the file and draw its contents
' onto the screen.

GOSUB GetLoop


' Use the graphics statement "GET" to capture the displayed image and store it
' in the matching variable array.  (0, 0)-(39, 39) captures an image 40 pixels
' wide by 40 pixels high.  This will change depending on the image.

GET (0, 0)-(39, 39), ManL()


' Close the file so that we can open another.

CLOSE #1



' Now repeat this for all remaining images.

OPEN "Resources\ManLStep.gfx" FOR BINARY AS 1 LEN = LEN(GT)
GOSUB GetLoop
GET (0, 0)-(39, 39), ManLStep()
CLOSE #1

OPEN "Resources\ManLCrouch.gfx" FOR BINARY AS 1 LEN = LEN(GT)
GOSUB GetLoop
GET (0, 0)-(39, 39), ManLCrouch()
CLOSE #1

OPEN "Resources\ManLfi8.gfx" FOR BINARY AS 1 LEN = LEN(GT)
GOSUB GetLoop
GET (0, 0)-(39, 39), ManLfi8()
CLOSE #1

OPEN "Resources\ManLfi7.gfx" FOR BINARY AS 1 LEN = LEN(GT)
GOSUB GetLoop
GET (0, 0)-(39, 39), ManLfi7()
CLOSE #1

OPEN "Resources\ManLfi6.gfx" FOR BINARY AS 1 LEN = LEN(GT)
GOSUB GetLoop
GET (0, 0)-(39, 39), ManLfi6()
CLOSE #1

OPEN "Resources\ManLfi5.gfx" FOR BINARY AS 1 LEN = LEN(GT)
GOSUB GetLoop
GET (0, 0)-(39, 39), ManLfi5()
CLOSE #1

OPEN "Resources\ManLCfi8.gfx" FOR BINARY AS 1 LEN = LEN(GT)
GOSUB GetLoop
GET (0, 0)-(39, 39), ManLCfi8()
CLOSE #1

OPEN "Resources\ManLCfi7.gfx" FOR BINARY AS 1 LEN = LEN(GT)
GOSUB GetLoop
GET (0, 0)-(39, 39), ManLCfi7()
CLOSE #1

OPEN "Resources\ManLCfi6.gfx" FOR BINARY AS 1 LEN = LEN(GT)
GOSUB GetLoop
GET (0, 0)-(39, 39), ManLCfi6()
CLOSE #1

OPEN "Resources\ManLCfi5.gfx" FOR BINARY AS 1 LEN = LEN(GT)
GOSUB GetLoop
GET (0, 0)-(39, 39), ManLCfi5()
CLOSE #1



OPEN "Resources\ManR.gfx" FOR BINARY AS 1 LEN = LEN(GT)
GOSUB GetLoop
GET (0, 0)-(39, 39), ManR()
CLOSE #1

OPEN "Resources\ManRStep.gfx" FOR BINARY AS 1 LEN = LEN(GT)
GOSUB GetLoop
GET (0, 0)-(39, 39), ManRStep()
CLOSE #1

OPEN "Resources\ManRCrouch.gfx" FOR BINARY AS 1 LEN = LEN(GT)
GOSUB GetLoop
GET (0, 0)-(39, 39), ManRCrouch()
CLOSE #1

OPEN "Resources\ManRfi8.gfx" FOR BINARY AS 1 LEN = LEN(GT)
GOSUB GetLoop
GET (0, 0)-(39, 39), ManRfi8()
CLOSE #1

OPEN "Resources\ManRfi7.gfx" FOR BINARY AS 1 LEN = LEN(GT)
GOSUB GetLoop
GET (0, 0)-(39, 39), ManRfi7()
CLOSE #1

OPEN "Resources\ManRfi6.gfx" FOR BINARY AS 1 LEN = LEN(GT)
GOSUB GetLoop
GET (0, 0)-(39, 39), ManRfi6()
CLOSE #1

OPEN "Resources\ManRfi5.gfx" FOR BINARY AS 1 LEN = LEN(GT)
GOSUB GetLoop
GET (0, 0)-(39, 39), ManRfi5()
CLOSE #1

OPEN "Resources\ManRCfi8.gfx" FOR BINARY AS 1 LEN = LEN(GT)
GOSUB GetLoop
GET (0, 0)-(39, 39), ManRCfi8()
CLOSE #1

OPEN "Resources\ManRCfi7.gfx" FOR BINARY AS 1 LEN = LEN(GT)
GOSUB GetLoop
GET (0, 0)-(39, 39), ManRCfi7()
CLOSE #1

OPEN "Resources\ManRCfi6.gfx" FOR BINARY AS 1 LEN = LEN(GT)
GOSUB GetLoop
GET (0, 0)-(39, 39), ManRCfi6()
CLOSE #1

OPEN "Resources\ManRCfi5.gfx" FOR BINARY AS 1 LEN = LEN(GT)
GOSUB GetLoop
GET (0, 0)-(39, 39), ManRCfi5()
CLOSE #1



OPEN "Resources\Grass.gfx" FOR BINARY AS 1 LEN = LEN(GT)
GOSUB GetLoop
GET (0, 0)-(19, 19), Grass()
CLOSE #1



OPEN "Resources\DroidLeft.gfx" FOR BINARY AS 1 LEN = LEN(GT)
GOSUB GetLoop
GET (0, 0)-(19, 19), DroidLeft()
CLOSE #1

OPEN "Resources\DroidRight.gfx" FOR BINARY AS 1 LEN = LEN(GT)
GOSUB GetLoop
GET (0, 0)-(19, 19), DroidRight()
CLOSE #1



OPEN "Resources\RockDecalBottom.gfx" FOR BINARY AS 1 LEN = LEN(GT)
GOSUB GetLoop
GET (0, 0)-(29, 29), RockDecalBottom()
CLOSE #1

OPEN "Resources\RockDecalBottom1.gfx" FOR BINARY AS 1 LEN = LEN(GT)
GOSUB GetLoop
GET (0, 0)-(29, 29), RockDecalBottom1()
CLOSE #1

OPEN "Resources\RockDecalTop.gfx" FOR BINARY AS 1 LEN = LEN(GT)
GOSUB GetLoop
GET (0, 0)-(29, 29), RockDecalTop()
CLOSE #1

OPEN "Resources\RockDecalTop1.gfx" FOR BINARY AS 1 LEN = LEN(GT)
GOSUB GetLoop
GET (0, 0)-(29, 29), RockDecalTop1()
CLOSE #1



OPEN "Resources\SmallHeart.gfx" FOR BINARY AS 1 LEN = LEN(GT)
GOSUB GetLoop
GET (0, 0)-(19, 19), SmallHeart()
CLOSE #1

OPEN "Resources\SmallHeart1.gfx" FOR BINARY AS 1 LEN = LEN(GT)
GOSUB GetLoop
GET (0, 0)-(19, 19), SmallHeart1()
CLOSE #1

OPEN "Resources\HalfHeart.gfx" FOR BINARY AS 1 LEN = LEN(GT)
GOSUB GetLoop
GET (0, 0)-(19, 19), HalfHeart()
CLOSE #1

OPEN "Resources\HalfHeart1.gfx" FOR BINARY AS 1 LEN = LEN(GT)
GOSUB GetLoop
GET (0, 0)-(19, 19), HalfHeart1()
CLOSE #1



OPEN "Resources\CrateWood.gfx" FOR BINARY AS 1 LEN = LEN(GT)
GOSUB GetLoop
GET (0, 0)-(29, 29), CrateWood()
CLOSE #1



OPEN "Resources\DoorBottom.gfx" FOR BINARY AS 1 LEN = LEN(GT)
GOSUB GetLoop
GET (0, 0)-(39, 39), DoorBottom()
CLOSE #1

OPEN "Resources\DoorTop.gfx" FOR BINARY AS 1 LEN = LEN(GT)
GOSUB GetLoop
GET (0, 0)-(9, 9), DoorTop()
CLOSE #1

OPEN "Resources\DoorOpen.gfx" FOR BINARY AS 1 LEN = LEN(GT)
GOSUB GetLoop
GET (0, 0)-(9, 9), DoorOpen()
CLOSE #1


' Now that we are finished we can switch screen pages and start drawing to the
' screen in the main game loop and exit the SUB routine.

SCREEN _NEWIMAGE(320, 200, 256), , 0, 0

EXIT SUB

At the very bottom of the subroutine we need this piece of code under the GetLoop label. No need to sweat over the details as I will provide a drawing program that saves your images into this format. For learning purposes, explore how the GET (file statement) command works. We read the size of our image from the file and then loop through it row by row, reading the color of pixels and pasting them on the screen with PSET, which we later grab with the GET (graphics statement) and store into a memory buffer.

GetLoop:

' This looks trickier than it is...

' First we find the end of the file and store it as LoopIncrement

LoopIncrement = LOF(1) ' LOF stands for Last of File and 1 is our open file.


' Now we read the last record (End of File, - 1 Record Length, + 1)

GET #1, LoopIncrement - GTIncrement + 1, GT


' Work out how large the image is by reading the last X and Y Co-Ordinates

PointX = VAL(GT.PX)
PointY = VAL(GT.PY)


' LoopIncrement is set to -GTIncrement so that when the loop starts and
' GTIncrement is added back in, the records will start at 0.

LoopIncrement = -GTIncrement


' This loop starts at co-ordinate 0, 0 and works its way to 39, 39 (in the
' first case).  PointX and PointY were determined earlier.

FOR DrawY = 0 TO PointY

  FOR DrawX = 0 TO PointX

    ' Read the current record values

    GET #1, LoopIncrement + GTIncrement + 1, GT

    ' We are only interested in the colour value which we will set to PointCo.
    ' We need to use the VAL function because GT.PCO is a STRING and we need
    ' to convert it to an INTEGER.

    PointCo = VAL(GT.PCO)

    ' Now that we have an X, Y and Colour value we can draw the pixel on the
    ' screen using PSET.

    PSET (DrawX, DrawY), PointCo

    ' We now increase LoopIncrement by GTIncrement to move to the next record
    ' and continue looping until the last pixel is drawn.

    LoopIncrement = LoopIncrement + GTIncrement

  NEXT DrawX

NEXT DrawY


' The image is now printed in full and can be captured by the GET command back
' in the GetImages main program code...

RETURN

END SUB

Below the main loop, under SYSTEM, we'll define our tiles for the single screen scene we'll be displaying and are purely specific for this example. The way you will store and load them is up to you. In this very program they are hard-coded. The tiles are defined by type (floor, wall, ...), property (straight, slanted edge, ...), colors and position (start, end).

gsGetTiles:

' Normally in larger games you would read these values from a level file of
' some sort rather than create them in code, however for this example we only
' have one screen to display so we will just create each tile manually.

' To do this we need to define a Type, some Properties, Colours and Position
' for each tile so that the DrawImages SUB routine can arrange them on the
' screen appropriately.


' Create a floor tile with straight sides, in two shades of brown, starting
' from x(-20), y(180) and finishing at x(339), y(199).

TileType(0) = 0 '                0 for Floor
TileProperty1(0) = 0 '           0 for Straight edges
TileColour1(0) = 6 '             6 for Standard Brown Colour
TileColour2(0) = 42 '            42 for Light Brown Colour
TileX1(0) = -20 '                The Co-ordinates from above
TileY1(0) = 180
TileX2(0) = 339
TileY2(0) = 199

' There, done, the first tile has been created, now to make some more floors

TileType(1) = 0 '                0 for Floor
TileProperty1(1) = 2 '           2 for Slanted edges
TileColour1(1) = 6 '             6 for Standard Brown Colour
TileColour2(1) = 42 '            42 for Light Brown Colour
TileX1(1) = -20 '                In the middle on the left hand side
TileY1(1) = 90
TileX2(1) = 119
TileY2(1) = 109

TileType(2) = 0 '                0 for Floor
TileProperty1(2) = 2 '           2 for Slanted edges
TileColour1(2) = 6 '             6 for Standard Brown Colour
TileColour2(2) = 42 '            42 for Light Brown Colour
TileX1(2) = 200 '                In the middle on the Right hand side
TileY1(2) = 90
TileX2(2) = 339
TileY2(2) = 109

TileType(3) = 0 '                0 for Floor
TileProperty1(3) = 0 '           0 for Straight edges
TileColour1(3) = 6 '             6 for Standard Brown Colour
TileColour2(3) = 42 '            42 for Light Brown Colour
TileX1(3) = -20 '                A roof for the room
TileY1(3) = 0
TileX2(3) = 339
TileY2(3) = 19


' Now for some walls...

TileType(4) = 1 '                1 for Wall
TileProperty1(4) = 2 '           2 for Slanted edges
TileColour1(4) = 6 '             6 for Standard Brown Colour
TileColour2(4) = 42 '            42 for Light Brown Colour
TileX1(4) = -20 '                Top Left Hand Side
TileY1(4) = 20
TileX2(4) = 39
TileY2(4) = 89

TileType(5) = 1 '                1 for Wall
TileProperty1(5) = 1 '           1 for Rounded edges
TileColour1(5) = 6 '             6 for Standard Brown Colour
TileColour2(5) = 42 '            42 for Light Brown Colour
TileX1(5) = 280 '                Bottom Right Hand Side
TileY1(5) = 110
TileX2(5) = 339
TileY2(5) = 179

TileType(6) = 1 '                1 for Wall
TileProperty1(6) = 1 '           1 for Rounded edges
TileColour1(6) = 6 '             6 for Standard Brown Colour
TileColour2(6) = 42 '            42 for Light Brown Colour
TileX1(6) = 220 '                Bottom Right Hand Cieling
TileY1(6) = 110
TileX2(6) = 299
TileY2(6) = 129

TileType(7) = 1 '                1 for Wall
TileProperty1(7) = 1 '           1 for Rounded edges
TileColour1(7) = 6 '             6 for Standard Brown Colour
TileColour2(7) = 42 '            42 for Light Brown Colour
TileX1(7) = 20 '                 Top Left Hand Cieling
TileY1(7) = 20
TileX2(7) = 99
TileY2(7) = 39


' And now some Droids...

TileType(8) = 14 '               14 for Droid
TileProperty1(8) = 10 '          10 hit points
TileProperty2(8) = 0 '           0 to spawn facing left
TileX1(8) = 60 '                 Bottom Floor
TileY1(8) = 160
TileX2(8) = 79
TileY2(8) = 179

TileType(9) = 14 '               14 for Droid
TileProperty1(9) = 10 '          10 hit points
TileProperty2(9) = 1 '           1 to spawn facing right
TileX1(9) = 160 '                Bottom Floor
TileY1(9) = 160
TileX2(9) = 179
TileY2(9) = 179


' And a Crate or two for good luck...

TileType(10) = 15 '               15 for Crate
TileProperty1(10) = 10 '          10 hit points
TileProperty2(10) = 0 '           0 to spawn as a wooden crate
TileX1(10) = 240 '                Bottom Floor
TileY1(10) = 150
TileX2(10) = 279
TileY2(10) = 179

TileType(11) = 15 '               15 for Crate
TileProperty1(11) = 10 '          10 hit points
TileProperty2(11) = 0 '           0 to spawn as a wooden crate
TileX1(11) = 205 '                Bottom Floor
TileY1(11) = 150
TileX2(11) = 234
TileY2(11) = 179


' For instant awesome, just add rocks...

TileType(12) = 16 '               16 for Decal
TileProperty1(12) = 2 '           2 for Rocks
TileProperty2(12) = 0 '           0 for Bottom Left Side
TileX1(12) = 20 '                 Bottom Floor
TileY1(12) = 155
TileX2(12) = 49
TileY2(12) = 184

TileType(13) = 16 '               16 for Decal
TileProperty1(13) = 2 '           2 for Rocks
TileProperty2(13) = 1 '           1 for Bottom Right Side
TileX1(13) = 255 '                Bottom Floor
TileY1(13) = 155
TileX2(13) = 284
TileY2(13) = 184

TileType(14) = 16 '               16 for Decal
TileProperty1(14) = 2 '           2 for Rocks
TileProperty2(14) = 2 '           2 for Top Left Side
TileX1(14) = 35 '                 Top Floor
TileY1(14) = 35
TileX2(14) = 64
TileY2(14) = 64

TileType(15) = 16 '               16 for Decal
TileProperty1(15) = 2 '           2 for Rocks
TileProperty2(15) = 0 '           0 for Bottom Left Side
TileX1(15) = 30 '                 Top Floor
TileY1(15) = 65
TileX2(15) = 59
TileY2(15) = 94


' And a door to finish things off...

TileType(16) = 2 '                2 for Door
TileProperty1(16) = 0 '           0 for Unlocked
TileColour1(16) = 6 '             6 for Standard Brown Colour
TileColour2(16) = 42 '            42 for Light Brown Colour
TileX1(16) = 220 '                 Top Floor
TileY1(16) = 20
TileX2(16) = 239
TileY2(16) = 89

' If you are wondering why the tile type numbers are out of order its because
' the tile definitions are ripped straight from another game of mine and I'm
' only using a few of the available tiles in this demo to show the basic
' method of level building.


RETURN

What follows now is defining our DrawImages sub. It's a sub that draws all game tiles according to their type. The beginning:

SUB DrawImages


' Notice that any PUT graphics statements use the _CLIP parameter and have
' an ", 8" at the end.  _CLIP means the image can be placed off the screen and
' the eight at the end turns any pixel in the image with a colour value of
' 8 (Grey, same as background) into an invisible pixel for transperancy.


IF DrawWhat$ = "BackGround" THEN ' Draw Background objects only...

  LINE (0, 0)-(319, 199), 8, BF ' Colour the background Grey


  ' Cycle through the pre-defined tiles using DrawTile as an index...

  FOR DrawTile = 0 TO 29

    IF TileType(DrawTile) = 0 THEN GOSUB gsDrawFloor
    IF TileType(DrawTile) = 1 THEN GOSUB gsDrawWall
    IF TileType(DrawTile) = 2 THEN GOSUB gsDrawDoor
    IF TileType(DrawTile) = 15 THEN GOSUB gsDrawCrate

  NEXT DrawTile

  ' Search for green lines on the floors and place the grass image when detected

  GrassY = 90
  FOR GrassX = 0 TO 300 STEP 20

    GrassPoint = POINT(GrassX + 1, GrassY + 1) ' Top Floor
    IF GrassPoint = 2 THEN PUT (GrassX, GrassY), Grass(), _CLIP PSET, 8

    GrassPoint = POINT(GrassX + 1, GrassY + 91) ' Bottom Floor
    IF GrassPoint = 2 THEN PUT (GrassX, GrassY + 90), Grass(), _CLIP PSET, 8

  NEXT GrassX

ELSEIF DrawWhat$ = "FixedSprites" THEN ' Draw Fixed Sprites Only...


  ' Nothing here now, but you could put things like switches, teleports, etc

ELSEIF DrawWhat$ = "MovingSprites" THEN ' Draw Moving Sprites Only...

  FOR DrawTile = 0 TO 29

    IF TileType(DrawTile) = 14 THEN GOSUB gsDrawDroid ' Draw the Droids

  NEXT DrawTile

ELSE ' Draw the Decals...

  FOR DrawTile = 0 TO 29

    IF TileType(DrawTile) = 16 THEN GOSUB gsDrawDecal ' Draw the Rocks...

  NEXT DrawTile

END IF


EXIT SUB

This code should be self-explanatory for the most part. We loop through tiles and depending on their type we skip to a specific label that draws them. Now, below that we put the rest of the subroutine code, labels that draw specific tiles according to their type.

gsDrawFloor:


' This routine basically reads the tile properties and draws a floor to match.
' The code is taken straight from another game file of mine and some parts
' are not needed here but you can play around and see what you get...

LINE (TileX1(DrawTile), TileY1(DrawTile))-(TileX2(DrawTile), TileY1(DrawTile)), 0
SELECT CASE TileProperty1(DrawTile) ' What type of edges does it have?
  CASE 0
    LINE (TileX1(DrawTile), TileY1(DrawTile))-(TileX1(DrawTile), TileY2(DrawTile)), 0
    LINE (TileX1(DrawTile), TileY2(DrawTile))-(TileX2(DrawTile), TileY2(DrawTile)), 0
    LINE (TileX2(DrawTile), TileY1(DrawTile))-(TileX2(DrawTile), TileY2(DrawTile)), 0
  CASE 1
    LINE (TileX1(DrawTile), TileY1(DrawTile))-(TileX1(DrawTile), TileY2(DrawTile) - 5), 0
    LINE (TileX1(DrawTile), TileY2(DrawTile) - 5)-(TileX1(DrawTile) + 5, TileY2(DrawTile)), 0
    LINE (TileX1(DrawTile) + 5, TileY2(DrawTile))-(TileX2(DrawTile) - 5, TileY2(DrawTile)), 0
    LINE (TileX2(DrawTile), TileY2(DrawTile) - 5)-(TileX2(DrawTile) - 5, TileY2(DrawTile)), 0
    LINE (TileX2(DrawTile), TileY1(DrawTile))-(TileX2(DrawTile), TileY2(DrawTile) - 5), 0
  CASE 2
    LINE (TileX1(DrawTile), TileY1(DrawTile))-(TileX1(DrawTile) + 5, TileY2(DrawTile)), 0
    LINE (TileX1(DrawTile) + 5, TileY2(DrawTile))-(TileX2(DrawTile) - 5, TileY2(DrawTile)), 0
    LINE (TileX2(DrawTile) - 5, TileY2(DrawTile))-(TileX2(DrawTile), TileY1(DrawTile)), 0
  CASE 3
    LINE (TileX1(DrawTile), TileY1(DrawTile))-(TileX1(DrawTile), TileY2(DrawTile) - 5), 0
    LINE (TileX1(DrawTile), TileY2(DrawTile) - 5)-(TileX1(DrawTile) + 10, TileY2(DrawTile)), 0
    LINE (TileX1(DrawTile) + 10, TileY2(DrawTile))-(TileX2(DrawTile) - 10, TileY2(DrawTile)), 0
    LINE (TileX2(DrawTile), TileY2(DrawTile) - 5)-(TileX2(DrawTile) - 10, TileY2(DrawTile)), 0
    LINE (TileX2(DrawTile), TileY1(DrawTile))-(TileX2(DrawTile), TileY2(DrawTile) - 5), 0
END SELECT

IF TileX1(DrawTile) < 0 THEN PAINT (TileX1(DrawTile) + 20, TileY1(DrawTile) + 1), TileColour1(DrawTile), 0
IF TileX1(DrawTile) >= 0 THEN PAINT (TileX1(DrawTile) + 2, TileY1(DrawTile) + 1), TileColour1(DrawTile), 0

IF NOT TileX1(DrawTile) > TileX2(DrawTile) - 20 THEN LINE (TileX1(DrawTile) + 20, TileY1(DrawTile) + 1)-(TileX2(DrawTile) - 20, TileY1(DrawTile) + 9), TileColour2(DrawTile), BF

IF TileY1(DrawTile) = 0 THEN GOTO RoofTile ' No Grass on the roof...

IF TileColour1(DrawTile) = 4 THEN
  DrawCo1 = 112
  DrawCo2 = 184
END IF

IF TileColour1(DrawTile) = 6 THEN
  DrawCo1 = 2
  DrawCo2 = 120
END IF

IF TileColour1(DrawTile) > 15 AND TileColour1(DrawTile) < 25 THEN
  DrawCo1 = 43
  DrawCo2 = 6
END IF

IF TileColour1(DrawTile) > 24 AND TileColour1(DrawTile) < 32 THEN
  DrawCo1 = 44
  DrawCo2 = 42
END IF

IF TileColour1(DrawTile) = 115 THEN
  DrawCo1 = 42
  DrawCo2 = 6
END IF

IF TileColour1(DrawTile) = 53 THEN
  DrawCo1 = 15
  DrawCo2 = 7
END IF

IF TileColour1(DrawTile) = 56 THEN
  DrawCo1 = 48
  DrawCo2 = 10
END IF



LINE (TileX1(DrawTile), TileY1(DrawTile) + 1)-(TileX2(DrawTile), TileY1(DrawTile) + 1), DrawCo1
LINE (TileX1(DrawTile), TileY1(DrawTile) + 2)-(TileX2(DrawTile), TileY1(DrawTile) + 2), DrawCo2


RoofTile:

' Don't draw grass on the roof...

RETURN


gsDrawWall:

' This routine basically reads the tile properties and draws a Wall to match.
' The code is taken straight from another game file of mine and some parts
' are not needed here but you can play around and see what you get...


LINE (TileX1(DrawTile), TileY1(DrawTile))-(TileX2(DrawTile), TileY1(DrawTile)), 0
LINE (TileX1(DrawTile) + 10, TileY1(DrawTile) + 1)-(TileX2(DrawTile) - 10, TileY2(DrawTile) - 1), TileColour1(DrawTile), BF

SELECT CASE TileProperty1(DrawTile) ' What type of edges does it have?
  CASE 0
    LINE (TileX1(DrawTile), TileY1(DrawTile))-(TileX1(DrawTile), TileY2(DrawTile)), 0
    LINE (TileX1(DrawTile), TileY2(DrawTile))-(TileX2(DrawTile), TileY2(DrawTile)), 0
    LINE (TileX2(DrawTile), TileY1(DrawTile))-(TileX2(DrawTile), TileY2(DrawTile)), 0
  CASE 1
    LINE (TileX1(DrawTile), TileY1(DrawTile))-(TileX1(DrawTile), TileY2(DrawTile) - 5), 0
    LINE (TileX1(DrawTile), TileY2(DrawTile) - 5)-(TileX1(DrawTile) + 5, TileY2(DrawTile)), 0
    LINE (TileX1(DrawTile) + 5, TileY2(DrawTile))-(TileX2(DrawTile) - 5, TileY2(DrawTile)), 0
    LINE (TileX2(DrawTile), TileY2(DrawTile) - 5)-(TileX2(DrawTile) - 5, TileY2(DrawTile)), 0
    LINE (TileX2(DrawTile), TileY1(DrawTile))-(TileX2(DrawTile), TileY2(DrawTile) - 5), 0
  CASE 2
    LINE (TileX1(DrawTile), TileY1(DrawTile))-(TileX1(DrawTile) + 5, TileY2(DrawTile)), 0
    LINE (TileX1(DrawTile) + 5, TileY2(DrawTile))-(TileX2(DrawTile) - 5, TileY2(DrawTile)), 0
    LINE (TileX2(DrawTile) - 5, TileY2(DrawTile))-(TileX2(DrawTile), TileY1(DrawTile)), 0
  CASE 3
    LINE (TileX1(DrawTile), TileY1(DrawTile))-(TileX1(DrawTile), TileY2(DrawTile) - 5), 0
    LINE (TileX1(DrawTile), TileY2(DrawTile) - 5)-(TileX1(DrawTile) + 10, TileY2(DrawTile)), 0
    LINE (TileX1(DrawTile) + 10, TileY2(DrawTile))-(TileX2(DrawTile) - 10, TileY2(DrawTile)), 0
    LINE (TileX2(DrawTile), TileY2(DrawTile) - 5)-(TileX2(DrawTile) - 10, TileY2(DrawTile)), 0
    LINE (TileX2(DrawTile), TileY1(DrawTile))-(TileX2(DrawTile), TileY2(DrawTile) - 5), 0
END SELECT

IF TileX1(DrawTile) < 0 THEN PAINT (TileX1(DrawTile) + 20, TileY1(DrawTile) + 1), TileColour1(DrawTile), 0
IF TileX1(DrawTile) >= 0 THEN PAINT (TileX1(DrawTile) + 2, TileY1(DrawTile) + 1), TileColour1(DrawTile), 0

LINE (TileX1(DrawTile) + 1, TileY1(DrawTile))-(TileX2(DrawTile) - 1, TileY1(DrawTile)), TileColour1(DrawTile)

LINE (TileX1(DrawTile) + 10, TileY1(DrawTile) + 1)-(TileX2(DrawTile) - 10, TileY2(DrawTile) - 10), TileColour2(DrawTile), BF

RETURN


gsDrawDoor:


' This routine draws the door either open or closed, locked or unlocked, etc

LINE (TileX1(DrawTile), TileY1(DrawTile))-(TileX1(DrawTile) + 19, TileY1(DrawTile) + 19), 0, B
LINE (TileX1(DrawTile) + 1, TileY1(DrawTile) - 1)-(TileX1(DrawTile) + 18, TileY1(DrawTile) + 18), TileColour1(DrawTile), BF
LINE (TileX1(DrawTile) + 5, TileY1(DrawTile) - 10)-(TileX1(DrawTile) + 14, TileY1(DrawTile) + 9), TileColour2(DrawTile), BF
PSET (TileX1(DrawTile), TileY1(DrawTile) + 19), 20
PSET (TileX2(DrawTile), TileY1(DrawTile) + 19), 20


' If the door is unlocked and the man is standing under it then draw it open.

IF MnY > TileY1(DrawTile) AND MnY < TileY2(DrawTile) AND MnX >= TileX1(DrawTile) - 25 AND MnX <= TileX2(DrawTile) + 26 AND TileProperty1(DrawTile) = 0 THEN

  PUT (TileX1(DrawTile) + 5, TileY1(DrawTile) + 20), DoorOpen(), _CLIP PSET, 8

ELSE

  PUT (TileX1(DrawTile) + 5, TileY1(DrawTile) + 30), DoorBottom(), _CLIP PSET, 8
  PUT (TileX1(DrawTile) + 5, TileY1(DrawTile) + 20), DoorTop(), _CLIP PSET, 8

  IF TileProperty1(DrawTile) = 0 THEN

    IF TimeCount = 1 OR TimeCount = 3 THEN

      LINE (TileX1(DrawTile) + 9, TileY1(DrawTile) + 39)-(TileX1(DrawTile) + 10, TileY1(DrawTile) + 50), 192, B
      LINE (TileX1(DrawTile) + 9, TileY1(DrawTile) + 41)-(TileX1(DrawTile) + 10, TileY1(DrawTile) + 48), 120, B
      LINE (TileX1(DrawTile) + 9, TileY1(DrawTile) + 43)-(TileX1(DrawTile) + 10, TileY1(DrawTile) + 46), 2, B

    END IF

  ELSE

    IF TimeCount = 1 OR TimeCount = 3 THEN ' Make the light flash once per second

      LINE (TileX1(DrawTile) + 9, TileY1(DrawTile) + 39)-(TileX1(DrawTile) + 10, TileY1(DrawTile) + 50), 112, B
      LINE (TileX1(DrawTile) + 9, TileY1(DrawTile) + 41)-(TileX1(DrawTile) + 10, TileY1(DrawTile) + 48), 4, B
      LINE (TileX1(DrawTile) + 9, TileY1(DrawTile) + 43)-(TileX1(DrawTile) + 10, TileY1(DrawTile) + 46), 40, B

    ELSE

      LINE (TileX1(DrawTile) + 9, TileY1(DrawTile) + 39)-(TileX1(DrawTile) + 10, TileY1(DrawTile) + 50), 184, B
      LINE (TileX1(DrawTile) + 9, TileY1(DrawTile) + 41)-(TileX1(DrawTile) + 10, TileY1(DrawTile) + 48), 112, B
      LINE (TileX1(DrawTile) + 9, TileY1(DrawTile) + 43)-(TileX1(DrawTile) + 10, TileY1(DrawTile) + 46), 4, B

    END IF

  END IF

END IF

RETURN




gsDrawDroid:


' This routine draws and moves the droids, they bounce up and down based on
' the GameTimer value, whether it is negative or positive.


IF TileProperty1(DrawTile) > 0 THEN

  IF TileProperty2(DrawTile) = 0 THEN


    DroidTest = POINT(TileX1(DrawTile) - 1, TileY2(DrawTile) + 1)
    IF DroidTest <> 0 THEN TileProperty2(DrawTile) = 1

    DroidTest = POINT(TileX1(DrawTile) - 1, TileY1(DrawTile) + 1)
    IF DroidTest <> 8 THEN TileProperty2(DrawTile) = 1

    TileX1(DrawTile) = TileX1(DrawTile) - 1
    TileX2(DrawTile) = TileX2(DrawTile) - 1

    IF GameTimer > 0 THEN PUT (TileX1(DrawTile), TileY1(DrawTile)), DroidLeft(), _CLIP PSET, 8
    IF GameTimer < 0 THEN PUT (TileX1(DrawTile), TileY1(DrawTile) + 1), DroidLeft(), _CLIP PSET, 8

  ELSE

    DroidTest = POINT(TileX2(DrawTile) + 1, TileY2(DrawTile) + 1)
    IF DroidTest <> 0 THEN TileProperty2(DrawTile) = 0

    DroidTest = POINT(TileX2(DrawTile) + 1, TileY1(DrawTile) + 1)
    IF DroidTest <> 8 THEN TileProperty2(DrawTile) = 0

    TileX1(DrawTile) = TileX1(DrawTile) + 1
    TileX2(DrawTile) = TileX2(DrawTile) + 1

    IF GameTimer > 0 THEN PUT (TileX1(DrawTile), TileY1(DrawTile)), DroidRight(), _CLIP PSET, 8
    IF GameTimer < 0 THEN PUT (TileX1(DrawTile), TileY1(DrawTile) + 1), DroidRight(), _CLIP PSET, 8

  END IF

END IF

RETURN


gsDrawCrate:

' Put a wooden crate on the screen somewhere...


IF TileProperty1(DrawTile) > 0 THEN

  IF TileProperty2(DrawTile) = 0 THEN PUT (TileX1(DrawTile), TileY1(DrawTile) + 1), CrateWood(), _CLIP PSET, 8

END IF

RETURN


gsDrawDecal:

' Draw some rocks...

SELECT CASE TileProperty1(DrawTile)

  CASE 2

    IF TileProperty2(DrawTile) = 0 THEN PUT (TileX1(DrawTile), TileY1(DrawTile)), RockDecalBottom(), _CLIP PSET, 8
    IF TileProperty2(DrawTile) = 1 THEN PUT (TileX1(DrawTile), TileY1(DrawTile)), RockDecalBottom1(), _CLIP PSET, 8
    IF TileProperty2(DrawTile) = 2 THEN PUT (TileX1(DrawTile), TileY1(DrawTile)), RockDecalTop(), _CLIP PSET, 8
    IF TileProperty2(DrawTile) = 3 THEN PUT (TileX1(DrawTile), TileY1(DrawTile)), RockDecalTop1(), _CLIP PSET, 8

END SELECT


RETURN


END SUB

Let's now call this subroutine in our main loop and draw all that stuff. Put in the main loop the following code below POKE 1132, 0:

' Draw the Background, Floors and Walls Only...

  DrawWhat$ = "BackGround"

  DrawImages
  
  ' Now that we have tested for collisions we can draw the more complex
  ' images onto the screen starting with the Fixed Sprites...

  DrawWhat$ = "FixedSprites"

  DrawImages
  
  ' Now we can draw the interactive sprites.

  DrawWhat$ = "MovingSprites"

  DrawImages

  ' The foreground images are placed in front of the man, aswell as the HUD

  DrawWhat$ = "ForeGround"

  DrawImages

But before that, we need to call the images loading sub before our loop. Place this code below ON ERROR line of code:

' Here we call the GetImages SUB routine which will load all the game images
' we require for use throughout the game.

GTIncrement = 7 ' The length of our Graphics Type (defined at the beggining)

GetImages

And finally call the tiles definitions below ResetTile loop:

' Call the gsGetTiles GOSUB routine to create the game objects.

GOSUB gsGetTiles

The entire code so far: working_code_1.txt

Compile and run this code and a room with doors and crates should appear on the screen, including the moving droids.

What is left is to implement the player (drawing/moving) and draw the HUD. Let's go!

SUB DrawMan

' This SUB routine draws the man in his many varying states, you can follow
' it down line for line to work out which frame gets drawn and why...


IF MnHealth >= 315 THEN

  SELECT CASE MnHurtOn

    CASE IS > 28, IS < -28

      IF MnSide = 0 THEN PUT (MnX - 20, MnY), ManLDie(), _CLIP PSET, 8
      IF MnSide = 1 THEN PUT (MnX - 20, MnY), ManRDie(), _CLIP PSET, 8

    CASE IS > 26, IS < -26

      IF MnSide = 0 THEN PUT (MnX - 20, MnY), ManLDie1(), _CLIP PSET, 8
      IF MnSide = 1 THEN PUT (MnX - 20, MnY), ManRDie1(), _CLIP PSET, 8

    CASE IS > 24, IS < -24

      IF MnSide = 0 THEN PUT (MnX - 20 + 20, MnY + 7), ManLDie2(), _CLIP PSET, 8
      IF MnSide = 1 THEN PUT (MnX - 20 - 20, MnY + 7), ManRDie2(), _CLIP PSET, 8

    CASE IS > 20, IS < -20, IS > 10

      IF MnSide = 0 THEN PUT (MnX - 20 + 20, MnY + 7), ManLDie3(), _CLIP PSET, 8
      IF MnSide = 1 THEN PUT (MnX - 20 - 20, MnY + 7), ManRDie3(), _CLIP PSET, 8

  END SELECT

  EXIT SUB

END IF

IF MnWeapon = 0 THEN

  SELECT CASE MnFireTimer

    CASE 8, 16

      IF MnCrouchOn = 0 THEN

        IF MnSide = 0 THEN PUT (MnX - 20 + 2, MnY), ManLfi8(), _CLIP PSET, 8
        IF MnSide = 1 THEN PUT (MnX - 20 - 2, MnY), ManRfi8(), _CLIP PSET, 8

      ELSE

        IF MnSide = 0 THEN PUT (MnX - 20 + 2, MnY), ManLCfi8(), _CLIP PSET, 8
        IF MnSide = 1 THEN PUT (MnX - 20 - 2, MnY), ManRCfi8(), _CLIP PSET, 8

      END IF

    CASE 7, 15

      IF MnCrouchOn = 0 THEN

        IF MnSide = 0 THEN PUT (MnX - 20 + 2, MnY), ManLfi7(), _CLIP PSET, 8
        IF MnSide = 1 THEN PUT (MnX - 20 - 2, MnY), ManRfi7(), _CLIP PSET, 8

      ELSE

        IF MnSide = 0 THEN PUT (MnX - 20 + 2, MnY), ManLCfi7(), _CLIP PSET, 8
        IF MnSide = 1 THEN PUT (MnX - 20 - 2, MnY), ManRCfi7(), _CLIP PSET, 8

      END IF

    CASE 6, 14

      IF MnCrouchOn = 0 THEN

        IF MnSide = 0 THEN PUT (MnX - 20 + 1, MnY), ManLfi6(), _CLIP PSET, 8
        IF MnSide = 1 THEN PUT (MnX - 20 - 1, MnY), ManRfi6(), _CLIP PSET, 8

      ELSE

        IF MnSide = 0 THEN PUT (MnX - 20 + 1, MnY), ManLCfi6(), _CLIP PSET, 8
        IF MnSide = 1 THEN PUT (MnX - 20 - 1, MnY), ManRCfi6(), _CLIP PSET, 8

      END IF

    CASE 5, 13

      IF MnCrouchOn = 0 THEN

        IF MnSide = 0 THEN PUT (MnX - 20 + 1, MnY), ManLfi5(), _CLIP PSET, 8
        IF MnSide = 1 THEN PUT (MnX - 20 - 1, MnY), ManRfi5(), _CLIP PSET, 8

      ELSE

        IF MnSide = 0 THEN PUT (MnX - 20 + 1, MnY), ManLCfi5(), _CLIP PSET, 8
        IF MnSide = 1 THEN PUT (MnX - 20 - 1, MnY), ManRCfi5(), _CLIP PSET, 8

      END IF

    CASE 4, 3, 2, 1, 0, 12, 11, 10, 9

      IF MnCrouchOn = 0 THEN


        IF (MnWalkOn = 0 OR MnWalkOn = -1 OR MnWalkOn = -4 OR MnWalkOn = 1 OR MnWalkOn = 4) AND MnJumpOn = 0 THEN
          IF MnSide = 0 THEN PUT (MnX - 20, MnY), ManL(), _CLIP PSET, 8
          IF MnSide = 1 THEN PUT (MnX - 20, MnY), ManR(), _CLIP PSET, 8
        END IF

        IF MnWalkOn = -2 OR MnWalkOn = -3 OR MnWalkOn = 2 OR MnWalkOn = 3 OR MnJumpOn = 1 THEN
          IF MnSide = 0 THEN PUT (MnX - 20, MnY), ManLStep(), _CLIP PSET, 8
          IF MnSide = 1 THEN PUT (MnX - 20, MnY), ManRStep(), _CLIP PSET, 8
        END IF


      ELSE

        IF MnSide = 0 THEN PUT (MnX - 20, MnY), ManLCrouch(), _CLIP PSET, 8
        IF MnSide = 1 THEN PUT (MnX - 20, MnY), ManRCrouch(), _CLIP PSET, 8

      END IF


  END SELECT

ELSE

  SELECT CASE MnFireTimer

    CASE 8, 16

      IF MnCrouchOn = 0 THEN

        IF MnSide = 0 THEN PUT (MnX - 20 + 2, MnY), ManLPRfi8(), _CLIP PSET, 8
        IF MnSide = 1 THEN PUT (MnX - 20 - 2, MnY), ManRPRfi8(), _CLIP PSET, 8

      ELSE

        IF MnSide = 0 THEN PUT (MnX - 20 + 2, MnY), ManLPRCfi8(), _CLIP PSET, 8
        IF MnSide = 1 THEN PUT (MnX - 20 - 2, MnY), ManRPRCfi8(), _CLIP PSET, 8

      END IF

    CASE 7, 15

      IF MnCrouchOn = 0 THEN

        IF MnSide = 0 THEN PUT (MnX - 20 + 2, MnY), ManLPRfi7(), _CLIP PSET, 8
        IF MnSide = 1 THEN PUT (MnX - 20 - 2, MnY), ManRPRfi7(), _CLIP PSET, 8

      ELSE

        IF MnSide = 0 THEN PUT (MnX - 20 + 2, MnY), ManLPRCfi7(), _CLIP PSET, 8
        IF MnSide = 1 THEN PUT (MnX - 20 - 2, MnY), ManRPRCfi7(), _CLIP PSET, 8

      END IF

    CASE 6, 14

      IF MnCrouchOn = 0 THEN

        IF MnSide = 0 THEN PUT (MnX - 20 + 1, MnY), ManLPRfi6(), _CLIP PSET, 8
        IF MnSide = 1 THEN PUT (MnX - 20 - 1, MnY), ManRPRfi6(), _CLIP PSET, 8

      ELSE

        IF MnSide = 0 THEN PUT (MnX - 20 + 1, MnY), ManLPRCfi6(), _CLIP PSET, 8
        IF MnSide = 1 THEN PUT (MnX - 20 - 1, MnY), ManRPRCfi6(), _CLIP PSET, 8

      END IF

    CASE 5, 13

      IF MnCrouchOn = 0 THEN

        IF MnSide = 0 THEN PUT (MnX - 20 + 1, MnY), ManLPRfi5(), _CLIP PSET, 8
        IF MnSide = 1 THEN PUT (MnX - 20 - 1, MnY), ManRPRfi5(), _CLIP PSET, 8

      ELSE

        IF MnSide = 0 THEN PUT (MnX - 20 + 1, MnY), ManLPRCfi5(), _CLIP PSET, 8
        IF MnSide = 1 THEN PUT (MnX - 20 - 1, MnY), ManRPRCfi5(), _CLIP PSET, 8

      END IF

    CASE 4, 3, 2, 1, 0, 12, 11, 10, 9

      IF MnCrouchOn = 0 THEN


        IF (MnWalkOn = 0 OR MnWalkOn = -1 OR MnWalkOn = -4 OR MnWalkOn = 1 OR MnWalkOn = 4) AND MnJumpOn = 0 THEN
          IF MnSide = 0 THEN PUT (MnX - 20, MnY), ManLPR(), _CLIP PSET, 8
          IF MnSide = 1 THEN PUT (MnX - 20, MnY), ManRPR(), _CLIP PSET, 8
        END IF

        IF MnWalkOn = -2 OR MnWalkOn = -3 OR MnWalkOn = 2 OR MnWalkOn = 3 OR MnJumpOn = 1 THEN
          IF MnSide = 0 THEN PUT (MnX - 20, MnY), ManLPRStep(), _CLIP PSET, 8
          IF MnSide = 1 THEN PUT (MnX - 20, MnY), ManRPRStep(), _CLIP PSET, 8
        END IF


      ELSE

        IF MnSide = 0 THEN PUT (MnX - 20, MnY), ManLPRCrouch(), _CLIP PSET, 8
        IF MnSide = 1 THEN PUT (MnX - 20, MnY), ManRPRCrouch(), _CLIP PSET, 8

      END IF


  END SELECT


END IF

END SUB

It's just a bunch of example specific code, a set of many IF clauses that check the player's status (moving right or left - MnSide, crouching, walking or jumping, all that with our without firing, ...), and according to that status a specific sprite is drawn with PUT.

It's the similar thing with the HUD, where we draw the timer, the ammo and energy bar (hearts):

SUB Hud


' Timer

' Draw the Grey metal box around the timer...

LINE (140, 0)-(179, 15), 254, BF
LINE (130, 0)-(139, 19), 254
LINE (189, 0)-(180, 19), 254
LINE (140, 19)-(179, 19), 254

PAINT (135, 0), 25, 254

LINE (131, 0)-(139, 17), 27
LINE (188, 0)-(180, 17), 23
LINE (140, 18)-(179, 18), 23

LINE (139, 0)-(139, 15), 23, BF
LINE (180, 0)-(180, 15), 27, BF
LINE (140, 16)-(179, 16), 27


' If you've been playing for more than 5 minutes the clock turns red.


IF Mins < 5 THEN COLOR 120
IF Mins > 4 THEN COLOR 112


' Convert the Mins and Secs values into strings and trim them.

LOCATE 1, 19: PRINT LTRIM$(STR$(Mins)); " 0"
IF Secs < 10 THEN LOCATE 1, 22: PRINT LTRIM$(STR$(Secs))
IF Secs > 9 THEN LOCATE 1, 21: PRINT LTRIM$(STR$(Secs))


' Make the clock ":" ficker like an alarm clock.

IF (TimeCount = 1 OR TimeCount = 3) AND Mins < 5 THEN COLOR 2
IF (TimeCount = 1 OR TimeCount = 3) AND Mins > 4 THEN COLOR 4

LOCATE 1, 20: PRINT ":"


' A finishing touch to the metal exterior.

PSET (140, 15), 21
PSET (179, 15), 21




' Ammuntion


' Reload your shells if you run out.

IF MnAmmo < 9 AND TimeCount = 0 AND GameTimer = 1 THEN MnAmmo = MnAmmo + 3



' Draw the Empty Shell Casings...  90 is Full Ammo.

FOR empty = 3 TO 90 STEP 3

  LINE (empty, 193)-(empty, 196), 18
  LINE (empty + 1, 193)-(empty + 1, 196), 20

NEXT empty


' Draw the Shells based on your MnAmmo Status...

IF MnAmmo = 0 THEN ' No Ammo?  Draw Nothing!

ELSE


  ' Draw each shell 3 pixels apart until MnAmmo is reached.

  FOR HUDamo = 3 TO MnAmmo STEP 3

    PSET (HUDamo, 193), 44
    PSET (HUDamo + 1, 193), 43
    LINE (HUDamo, 194)-(HUDamo, 196), 40
    LINE (HUDamo + 1, 194)-(HUDamo + 1, 196), 4

  NEXT HUDamo

END IF




' Hearts

' Draw the hearts 10 pixels apart working backwards from 315

FOR HudHeart = 315 TO MnHealth STEP -10


  ' Make the hearts flash once per second...

  IF TimeCount = 1 OR TimeCount = 3 THEN
    PUT (HudHeart, 181), SmallHeart(), _CLIP PSET, 8
  ELSE
    PUT (HudHeart, 181), SmallHeart1(), _CLIP PSET, 8
  END IF


  ' Draw the Half Hearts if any...

  IF MnHealth = HudHeart - 5 THEN

    IF TimeCount = 1 OR TimeCount = 3 THEN
      PUT (HudHeart - 10, 181), HalfHeart(), _CLIP PSET, 8
    ELSE
      PUT (HudHeart - 10, 181), HalfHeart1(), _CLIP PSET, 8
    END IF

  END IF

NEXT HudHeart

END SUB

We'll call those subs now in the main loop to draw them. Player drawing will be placed below the moving sprites, and HUD at the end:

' Now we can draw the interactive sprites.

  DrawWhat$ = "MovingSprites"

  DrawImages
  
  ' Its now time to draw the Man, foreground objects and the HUD

  DrawMan ' Calls the SUB to draw the man based on his status

  ' The foreground images are placed in front of the man, aswell as the HUD

  DrawWhat$ = "ForeGround"

  DrawImages
  
  Hud ' Calls the SUB to draw the heads up display.

The entire code so far: working_code_2.txt

If you run it you will now see the HUD and the player drawn, but we can't move the player. This will be the final part we'll add.

Let's add some code now in the main loop, above background drawing. Keyboard shortcuts:


    ' Determine which keys are being pressed.  _KEYDOWN checks our constant
    ' codes from before and returns -1 if the key is being pressed.  Using
    ' these newly created variables we can now test acurately for keyboard
    ' input.

    UpOn = _KEYDOWN(Key_Up&)
    DownOn = _KEYDOWN(Key_Down&)
    LeftOn = _KEYDOWN(Key_Left&)
    RightOn = _KEYDOWN(Key_Right&)
    SpaceOn = _KEYDOWN(Key_Space&)
    EnterOn = _KEYDOWN(Key_Enter&)
    CtrlOn = _KEYDOWN(Key_Ctrl&)
    ShiftOn = _KEYDOWN(Key_Shift&)
    ZeroOn = _KEYDOWN(Key_KP_Zero&)

Below background drawing some collision check-up:

    ' Test the area around the Man to determine whether he should be able to
    ' Jump or Walk, or whether he should be falling down or not...  The POINT
    ' Command gets the colour value of the X and Y co-ordinates you are testing.
    ' We can then determine what should happen based on the colour returned.

    MPointLeft = POINT(MnX - 25, MnY)
    MPointRight = POINT(MnX + 24, MnY)
    MPointFallLeft = POINT(MnX - 20, MnY + 39)
    MPointFallRight = POINT(MnX + 19, MnY + 39)
    MPointJumpLeft = POINT(MnX - 15, MnY + 5)
    MPointJumpRight = POINT(MnX + 14, MnY + 5)
    IF MnSide = 0 THEN MPointJumpTop = POINT(MnX + 10, MnY - 15)
    IF MnSide = 1 THEN MPointJumpTop = POINT(MnX - 9, MnY - 15)
    MPointGroundLeft = POINT(MnX - 11, MnY + 40)
    MPointGroundRight = POINT(MnX + 10, MnY + 40)
    MPointGroundBottom = POINT(MnX, MnY + 40)

Some more collision code, below "fixed sprites" drawing:

 ' Reposition the Man if he has collided with a floor or wall.

    ' The MnX and MnY test are to make sure the Man is on the screen when we
    ' test.  The MPoint tests are to establish if there is ground below or
    ' ceiling above and we test differently depending on MnSide.  If these
    ' conditions are met, we move the man 20 pixels in either direction.

    IF (MnX > 20 AND NOT MnX > 300) AND MnY > 0 AND MnY < 160 AND (MPointFallLeft <> 8 OR MPointJumpLeft <> 8) AND MnSide = 0 AND MnY < 170 THEN MnX = MnX + 20
    IF (MnX < 300 AND NOT MnX < 20) AND MnY > 0 AND MnY < 160 AND (MPointFallRight <> 8 OR MPointJumpRight <> 8) AND MnSide = 1 AND MnY < 170 THEN MnX = MnX - 20

Below that, falling testing and falling code for the main player:

    ' Make the Man fall down


    ' Test the ground beneath the man if he is not already falling or jumping.

    IF (MPointGroundLeft = 8 AND MPointGroundRight = 8 AND MPointGroundBottom = 8 OR MnY > 150) AND MnFallOn = 0 AND MnJumpOn = 0 THEN MnFallOn = 1


    ' Increment MnFallOn until the desired delay has passed.

    IF MnFallOn > 0 THEN MnFallOn = MnFallOn + 1


    ' Once it reaches 4 we make him fall, a smaller number will make him fall
    ' faster, and vice versa.

    IF MnFallOn = 4 THEN


      ' Reset the fall variable so that we can perform the test again.

      MnFallOn = 0


      ' Test for ground if the man is on the top level or bottom level only.

      IF (MPointGroundLeft <> 8 OR MPointGroundRight <> 8) AND (MnY = 140 OR MnY = 50) THEN


        ' If ground is found then the man's Y position should remain the same.

      ELSE


        ' If no ground is found then we move the man down by 10 pixels

        MnY = MnY + 10

      END IF


      ' This line is optional, if the man falls of the bottom of the screen
      ' he will re-appear at the top of the screen, comment out to stop this
      ' but be sure to add code to kill the man if he does go off the screen
      ' otherwise he will fall forever.

      IF MnY > 200 THEN MnY = 0

    END IF

Note how the MPoint collision variables are used.

If SPACE is pressed, we invoke weapon firing code (below the code above):

 ' Make the Man Fire his Weapon

    ' If you have ammo and you press the spacebar and you are not already
    ' firing, walking or falling then we make him fire.

    IF SpaceOn = -1 AND MnAmmo > 0 AND MnFireTimer = 0 AND MnWalkOn = 0 AND MnFallOn = 0 THEN


      ' Take One Shell away

      MnAmmo = MnAmmo - 3


      ' Set this to 8 to start the firing animation

      MnFireTimer = 8


      ' This is used to delay the animation, once it reaches 4 we move to the
      ' next animation.

      MnFireOn = 1

    END IF


    ' Increment the Firing Animation Timer

    IF MnFireOn > 0 THEN MnFireOn = MnFireOn + 1


    ' If the desired delay has passed then make him fire.

    IF MnFireTimer > 0 AND MnFireOn = 4 THEN


      ' Reduce the Fire Timer until it returns to 0

      MnFireTimer = MnFireTimer - 1


      ' If the animation is still going then continue to reset the delay timer

      IF MnFireTimer > 0 THEN MnFireOn = 1
      IF MnFireTimer = 0 THEN MnFireOn = 0

    END IF


    ' At this point we test the shells path and draw the bullet flash

    IF MnFireOn = 3 AND MnFireTimer = 7 THEN


      ' Is the man facing left or right?

      SELECT CASE MnSide

        CASE 0 ' Left


          ' Test from the gun barrel till the end of the screen until we find
          ' something other than grey space.

          FOR fx = MnX - 19 TO 0 STEP -2

            IF MnCrouchOn = 0 THEN fy = MnY + 19 ' Standing Test
            IF MnCrouchOn = 1 THEN fy = MnY + 29 ' Crouching Test
            fPoint = POINT(fx, fy) ' What colour is behind the bullet?


            ' If its grey space then draw a yellow dot

            IF fPoint = 8 THEN

              PSET (fx, fy), 43

            ELSE


              ' If not then skip to the end and stop testing

              fx = 0

            END IF


          NEXT fx

        CASE 1 ' Right

          ' Test from the gun barrel till the end of the screen until we find
          ' something other than grey space.

          FOR fx = MnX + 19 TO 319 STEP 2

            IF MnCrouchOn = 0 THEN fy = MnY + 19 ' Standing Test
            IF MnCrouchOn = 1 THEN fy = MnY + 29 ' Crouching Test
            fPoint = POINT(fx, fy) ' What colour is behind the bullet?



            ' If its grey space then draw a yellow dot

            IF fPoint = 8 THEN

              PSET (fx, fy), 43

            ELSE


              ' If not then skip to the end and stop testing

              fx = 319

            END IF

          NEXT fx

      END SELECT

    END IF

Below that, the most important code, the code for moving left/right, crouching and jumping:

' Move the Man

    ' If you push left, without pushing right and there are no obstacles in
    ' front of you and you are also within range of the screen then walk...

    IF LeftOn = -1 AND RightOn = 0 AND MnWalkOn = 0 AND (MPointLeft = 8 OR MnX <= 20 OR MnX > 300) THEN

      MnWalkOn = -1

    END IF



    ' If you push right, without pushing left and there are no obstacles in
    ' front of you and you are also within range of the screen then walk...

    IF RightOn = -1 AND LeftOn = 0 AND MnWalkOn = 0 AND (MPointRight = 8 OR MnX >= 300 OR MnX < 20) THEN

      MnWalkOn = 1

    END IF


    ' Increment MnWalkTimer to create the desired animation delay.

    IF MnWalkOn <> 0 THEN MnWalkTimer = MnWalkTimer + 1


    ' Once the delay has passed we then call gsManMover to move the man

    IF MnWalkOn <> 0 AND MnWalkTimer > 2 THEN GOSUB gsManMover


    ' If the man walks off the screen we want him to re-appear on the other
    ' side (not normally, but for this demo we do...)

    IF MnX <= -20 AND MnY > 50 THEN

      MnX = MnX + 340

      MnY = MnY - 90

    END IF

    IF MnX >= 340 AND MnY <= 50 THEN

      MnX = MnX - 340

      MnY = MnY + 90

    END IF



    ' Crouching


    ' If you push down and you aren't already crouching, walking or jumping
    ' then make the Man crouch.

    IF DownOn = -1 AND MnCrouchOn = 0 AND MnWalkTimer = 0 AND MnJumpOn = 0 AND CrouchTime = 0 THEN MnCrouchOn = 1


    ' CrouchTime is set to 3 after you complete one walk animation.  You can
    ' only crouch if CrouchTime is 0.  This stops the man crouching for a
    ' split second if you hold the down key and move left or right.

    IF CrouchTime > 0 THEN CrouchTime = CrouchTime - 1


    ' If you stop pushing down or start walking or jumping then you will stop
    ' crouching.

    IF (DownOn = 0 OR MnWalkTimer <> 0 OR MnJumpOn = 1) AND MnCrouchOn = 1 THEN MnCrouchOn = 0


    ' Jumping

    ' If you press up and you aren't already jumping or falling and your
    ' standing on the ground with no obstacles above then make the man Jump!

    IF UpOn = -1 AND MnJumpOn = 0 AND (MnY = 140 OR MnY = 50) AND MnFallOn = 0 AND MPointJumpTop = 8 THEN MnJumpOn = 1


    ' If your jumping then increment JumpTimer until the desired delay is
    ' reached then reset it and call the MnJump Routine.

    IF MnJumpOn = 1 THEN

      JumpTimer = JumpTimer + 1

      IF JumpTimer > 3 THEN

        JumpTimer = 0
        GOSUB MnJump

      END IF

    END IF

Under the main loop above tiles definitions we need to place some code invoked by the code above:

gsManMover:

SELECT CASE MnWalkOn

  CASE IS > 0 ' Walking Right


    ' If you fire your weapon and then take a step backwards you will not
    ' turn around but instead remain facing your target.

    IF MnFireTimer = 0 THEN


      MnSide = 1 ' Turn around if not firing your gun.

    ELSE


      ' Test to see if you are going to collide with other objects and then
      ' reposition the man accordingly.

      IF MPointRight <> 8 THEN MnX = MnX - 20

    END IF


    ' Move man right, 5 pixels at a time.  Increment the animation, and reset
    ' it if it reaches the 5th rotation.

    MnX = MnX + 5
    MnWalkOn = MnWalkOn + 1
    IF MnWalkOn = 5 THEN MnWalkOn = 0

  CASE IS < 0 ' Walking Left


    ' If you fire your weapon and then take a step backwards you will not
    ' turn around but instead remain facing your target.

    IF MnFireTimer = 0 THEN


      MnSide = 0 ' Turn around if not firing your gun.

    ELSE


      ' Test to see if you are going to collide with other objects and then
      ' reposition the man accordingly.

      IF MPointLeft <> 8 THEN MnX = MnX + 20

    END IF


    ' Move man left, 5 pixels at a time.  Increment the animation, and reset
    ' it if it reaches the 5th rotation.

    MnX = MnX - 5
    MnWalkOn = MnWalkOn - 1
    IF MnWalkOn = -5 THEN MnWalkOn = 0

END SELECT

' Reset the Delay Variables...

MnWalkTimer = 0
CrouchTime = 3

RETURN




MnJump:

' Here we move the Man up and down in an arc like fashion depending on how
' long it has been since you started jumping.

SELECT CASE MJT ' Stands for Man Jump Timer

  CASE 0
    MnY = MnY - 10
  CASE 1
    MnY = MnY - 7
  CASE 2
    MnY = MnY - 5
  CASE 3
    MnY = MnY - 2
  CASE 4
    MnY = MnY - 1
  CASE 5, 6
  CASE 7
    MnY = MnY + 1
  CASE 8
    MnY = MnY + 2
  CASE 9
    MnY = MnY + 5
  CASE 10
    MnY = MnY + 7
  CASE 11
    MnY = MnY + 10


    ' The jump has now been completed and the variables are reset.

    MJT = -1
    JumpTimer = 0
    MnJumpOn = 0

END SELECT


' Increment the timer...

MJT = MJT + 1

RETURN

Let's just break down moving toward left. If the user pushed left arrow key (LeftOn = -1) and is not pushing right (RightOn = 0), is not walking (MnWalkOn = 0), and finally not colliding with anything to the left (collision point MPointLeft = 8), we set walk variable to -1 (MnWalkOn < 0 -> moving left). If MnWalkOn is different from 0 we increment a timer variable which then calls for the very movement code when it reaches a certain value (2 in our example). Below gsManMover label we have our movement code. It's a SELECT CASE statement that executes specific code according to MnWalkOn value. For moving left, as well as moving right, we check if the player is shooting (via MnFireTimer variable). If he is, we will not allow him to turn around. If he is not, we will allow him to turn around (toggle MnSide variable). If he is colliding with anything we reposition him (MPointRight <> 8). Finally, we change his MnX value accordingly and increment MnWalkOn (used to animate) until it reaches 5, then it loops back.

Let me remind you to a piece of code in DrawMan sub that uses these values to draw the proper sprite:

IF MnWalkOn = -2 OR MnWalkOn = -3 OR MnWalkOn = 2 OR MnWalkOn = 3 OR MnJumpOn = 1 THEN
          IF MnSide = 0 THEN PUT (MnX - 20, MnY), ManLStep(), _CLIP PSET, 8
          IF MnSide = 1 THEN PUT (MnX - 20, MnY), ManRStep(), _CLIP PSET, 8
END IF

And that's it. Our example program is done.

The entire code so far: working_code_3.txt

Compile and run it!

Download the whole package here (resource files, source code, binary): NewGame.zip (374 KB)

Download the image editor (saves files in custom made .gfx format): Image Creator.zip (4 KB)

Issue #7 ~ July 15th, 2012

In This Issue

Message from the Editor

News Briefs

New Releases

Project news

Game-dev libraries / Game-dev tools news

Compiler news

Website updates

Gallery - James Hetter's Revenge

Awards

How To Program A Game With QB64 - Lesson #1

Written by Lachie Dazdarian (June, 2012)

Introduction

Example #1: A simple program - The circle moves!

Example #2: A warrior running around a green field

Extra stuff: 32-bit color depth and example #2

FreeBASIC + Winsock P2P Chat Tutorial (With Non-Blocking Mode)

Written by Mark Koelemij (Marcade) and James Robert Osborne (WisdomDude) (June, 2012)

Introduction

The Tutorial

A Simple Platform Game

Written by Justin Richards, edited for the tutorial by Lachie Dazdarian (July, 2012)

Introduction

The Tutorial

Final Words