so, another game made while lecturing my classes... polished a bit and released here...
it's a console game but running on gfx screen
it's possible to set FontWid/FontHei to 1 to have it running as a true console program
(but mouse wont work in true console mode unless the ConsoleAuxiliar.bas is included, since freebasic SetMouse does not work in console mode (at least not on windows))
for keyboard, controls are arrows and space...
#include "fbgfx.bi"
const FontWid=8,FontHei=16 'GFX mode
'const FontWid=1,FontHei=1 'Console Mode
const LinCentro=12,ColCentro=40
enum ControlTypes
ctKeyboard , ctMouse , ctComputer
end enum
enum GameSpeeds
gsInsane , gsFast , gsNormal , gsSlow , gsTurtle
end enum
type ShotData
as byte Lin,Col
as byte DirLin,DirCol
end type
type PlayerData
as single Lin,Col
as ShotData Shot
as byte AntLin,AntCol
as byte AiVert,AiHorz
as byte Control,Score
end type
function UpdateShot( PlayerFrom as PlayerData , PlayerTo as PlayerData ) as long
with PlayerFrom
if abs(.Col-PlayerTo.Col) < 3 and abs(.Lin-PlayerTo.Lin) < 3 then
Locate PlayerTo.Lin , PlayerTo.Col-1
if .Score > 0 then .Score -= 1
color 14 : print "Bonk!";
return -2
end if
if .Shot.Lin = 0 then return 0
locate .Shot.Lin,.Shot.Col : print " ";
'se não tem Shot ativo ou se o Shot saiu da tela, cancela Shot e retorna
if ((.Shot.Lin+1)\2) = ((PlayerTo.Lin+1)\2) then
if ((.Shot.Col+1)\2) = ((PlayerTo.Col+2)\2) then
.Shot.Lin = 0 'termina Shot
Locate PlayerTo.Lin , PlayerTo.Col-1 : .score += 1
color 14 : print "Boom!";
return 1
end if
end if
.Shot.Lin = .Shot.Lin + .Shot.DirLin
.Shot.Col = .Shot.Col + .Shot.DirCol*2
if .Shot.Lin < 1 or .Shot.Lin > 25 or .Shot.Col < 1 or .Shot.Col > 80 then
.Shot.Lin = 0 'termina Shot
return 0
end if
color 14
locate .Shot.Lin,.Shot.Col : print "*";
return 0
end with
end function
function PlayerShoot( PlayerFrom as PlayerData , PlayerTo as PlayerData ) as long
with PlayerFrom
if .Shot.Lin <> 0 then return 0
'obtem a direção do Shot (linha/coluna)
.Shot.DirLin = sgn( (PlayerTo.Lin-PlayerFrom.Lin)\4 )
.Shot.DirCol = sgn( (PlayerTo.Col-PlayerFrom.Col)\4 )
'caso ambas Players estejam na mesma posição
if .Shot.DirLin=0 and .Shot.DirCol=0 then return 0
.Shot.Lin = .Lin
.Shot.Col = .Col+1
'faz o Shot começar fora da Player
if .Shot.DirLin > 0 then .Shot.Lin=.Shot.Lin+1
if .Shot.DirLin < 0 then .Shot.Lin=.Shot.Lin-2
.Shot.Col = .Shot.Col + .Shot.DirCol*2
return 1
end with
end function
sub ControlPlayerKeyboard( Player as PlayerData , Enemy as PlayerData )
with Player
if multikey( fb.SC_SPACE ) then
PlayerShoot( Player , Enemy )
end if
if multikey( fb.SC_UP ) then .Lin -= .9
if multikey( fb.SC_DOWN ) then .Lin += .9
if multikey( fb.SC_LEFT ) then .Col -= 1.75
if multikey( fb.SC_RIGHT ) then .Col += 1.75
end with
end sub
sub ControlPlayerMouse( Player as PlayerData , Enemy as PlayerData )
with Player
dim as integer MX,MY,MB
if getmouse(MX,MY,,MB) then exit sub
if MB <> 0 then 'Shot Player A (mouse)
PlayerShoot( Player , Enemy )
end if
if MX <> ColCentro or MY <> LinCentro then
Var spdCol = (MX-(ColCentro*FontWid))/(8*FontWid)
Var spdLin = (MY-(LinCentro*FontHei))/(8*FontHei)
if abs(spdCol) > 2 then spdCol = 2*sgn(spdCol)
if abs(spdLin) > 1.5 then spdLin = 1.5*sgn(spdLin)
.Col += spdCol : .Lin += spdLin
setmouse ColCentro*FontWid,LinCentro*FontHei
end if
end with
end sub
sub ControlPlayerComputer( Player as PlayerData , Enemy as PlayerData )
dim as single ChanceMovement = .1
with Player
dim as long DifVert = abs(Player.Lin - Enemy.Lin)
dim as long DifHorz = abs(Player.Col - Enemy.Col)
if DifVert<2 or DifHorz<2 or abs(DifVert-DifHorz)<2 then 'Shot Player B (teclado)
PlayerShoot( Player , Enemy )
end if
if Enemy.Shot.Lin <> 0 then ChanceMovement = .4
if .Shot.Lin <> 0 then ChanceMovement = ChanceMovement/3
if .AiVert = 0 then
if rnd < ChanceMovement then
.AiVert = 4+rnd*14
if rnd < (.Lin/24) then .AiVert = -.AiVert
end if
end if
if .AiHorz = 0 then
if rnd < ChanceMovement then
.AiHorz = 4+rnd*14
if rnd < (.Col/79) then .AiHorz = -.AiHorz
end if
end if
if .AiVert < 0 then .AiVert = .AiVert+1 : .Lin = .Lin-.5
if .AiVert > 0 then .AiVert = .AiVert-1 : .Lin = .Lin+.5
if .AiHorz < 0 then .AiHorz = .AiHorz+1 : .Col = .Col-.5
if .AiHorz > 0 then .AiHorz = .AiHorz-1 : .Col = .Col+.5
end with
end sub
sub ControlPlayer( Player as PlayerData , Enemy as PlayerData )
with Player
select case .Control
case ctKeyboard : ControlPlayerKeyboard( Player , Enemy )
case ctMouse : ControlPlayerMouse ( Player , Enemy )
case ctComputer : ControlPlayerComputer( Player , Enemy )
end select
if .Col < 2 then .Col = 2
if .Lin < 2 then .Lin = 2
if .Col > (80-2) then .Col = 80-2
if .Lin > (25-1) then .Lin = 25-1
end with
end sub
sub DrawPlayer( Player as PlayerData , ShipType as long )
with Player
if cint(.Col)<>.AntCol or cint(.Lin)<>.AntLin then
locate .AntLin-1,.AntCol+1 : Print " ";
locate .AntLin ,.AntCol : Print " ";
.AntCol=.Col : .AntLin=.Lin
if ShipType=0 then
color 10
locate .AntLin-1,.AntCol+1 : Print chr(&hB3);
locate .AntLin ,.AntCol : print chr(&hC4,&hC5,&hC4);
else
color 12
locate .AntLin-1,.AntCol+1 : Print chr(&hBA);
locate .AntLin ,.AntCol : Print chr(&hCD,&hCE,&hCD);
end if
end if
end with
end sub
if FontWid>1 then screenres FontWid*80,FontHei*25
width 80,25 : cls : locate ,,0
windowtitle "< Spade Ships >"
dim as PlayerData PlayerA,PlayerB
dim as integer GameSpeed = gsNormal
dim as string OptControl(2) = {"Keyboard","Mouse","Computer"}
dim as string OptSpeed(4) = {"Insane","Fast","Normal","Slow","Granny"}
PlayerA.Control = ctMouse : PlayerB.Control = ctComputer
do
cls : setmouse ,,1,0
while len(inkey): wend
do
color 14
locate 2,33 : print "/-------------\";
locate 3,33 : print !"\179 Spade Ships \179";
locate 4,33 : print "\-------------/";
color 13 : locate 6,29 : print "[ Select your options ]";
color 10 : locate 10,24 : print "(1)st Player ";OptControl(PlayerA.Control)
color 12 : locate 12,24 : print "(2)nd Player ";OptControl(PlayerB.Control)
color 11 : locate 14,24 : print "(S)peed ";OptSpeed(GameSpeed)
color 9 : locate 16,24 : print "(B)egin Match"
color 15 : locate 18,24 : print "(Q)uit"
var iKey = GetKey() : if iKey>255 then iKey = -(iKey shr 8)
select case iKey
case asc("1")
PlayerA.Control = (PlayerA.Control+1) mod 3
if PlayerA.Control = PlayerB.Control and PlayerA.Control <> ctComputer then PlayerA.Control += 1
case asc("2")
PlayerB.Control = (PlayerB.Control+1) mod 3
if PlayerB.Control = PlayerA.Control and PlayerB.Control <> ctComputer then PlayerB.Control += 1
case asc("S"),asc("s") : GameSpeed = (GameSpeed+1) mod 5
case asc("B"),asc("b") : exit do
case asc("Q"),asc("q"),-asc("k") : end 0
case else
end select
cls
loop
cls
with PlayerA
.Score = 0 : .AntLin = 0 : .Lin = 12 : .Shot.Lin = 0 : .AiVert = 0 : .AiHorz = 0
end with
with PlayerB
.Score = 0 : .AntLin = 0 : .Lin = 12 : .Shot.Lin = 0 : .AiVert = 0 : .AiHorz = 0
end with
PlayerA.Col = 20 : PlayerB.Col = 60
if PlayerA.Control = ctMouse or PlayerB.Control = ctMouse then
setmouse ColCentro,LinCentro,0,1
end if
dim as long iHit = 2
do
iHit += UpdateShot( PlayerA , PlayerB )
iHit += UpdateShot( PlayerB , PlayerA )
if iHit then
color 12 : locate 25,71 : Print "Score";playerB.score;
color 10 : locate 25,2 : Print "Score";playerA.score;
sleep 1000,1
if iHit < 0 then 'ship collision
PlayerA.Lin = 12 : PlayerA.Col = 20
PlayerB.Lin = 12 : PlayerB.Col = 60
end if
if PlayerA.Score = 3 then
color 10 : locate 12,30 : print !"\179 Player 1 Wins!!! \179" : sleep 400,1
color 10 : locate 11,30 : print "/------------------\" : sleep 200,1
color 10 : locate 13,30 : print "\------------------/" : sleep 600,1
while len(inkey): wend: sleep : exit do
end if
if PlayerB.Score = 3 then
color 12 : locate 12,30 : print !"\179 Player 2 Wins!!! \179" : sleep 400,1
color 12 : locate 11,30 : print "/------------------\" : sleep 200,1
color 12 : locate 13,30 : print "\------------------/" : sleep 600,1
while len(inkey): wend: sleep : exit do
end if
cls : PlayerA.AntLin=0 : PlayerB.AntLin=0 'force players to redraw
color 12 : locate 25,71 : Print "Score";playerB.score;
color 10 : locate 25,2 : Print "Score";playerA.score;
PlayerA.Shot.Lin = 0 : PlayerB.Shot.Lin = 0 : iHit = 0
end if
ControlPlayer( PlayerA , PlayerB )
ControlPlayer( PlayerB , PlayerA )
DrawPlayer( PlayerA , 0 )
DrawPlayer( PlayerB , 1 )
sleep 15+GameSpeed*15,1
do
dim as string sKey = inkey
if len(sKey)=0 then exit do
if sKey=chr(27) then exit do,do
if sKey=chr(255,asc("k")) then end 0
loop
loop
loop
Screenshot attached.
Interesting mechanics. Gotta really move fast.
It would be crazy if each level had another npc.
yeah indeed, despite the simplified method is not really the best for more objects... hehe i noticed that even tough setmouse would not work on real console... it's still possible to use the mouse by keeping it near the center of the screen... but then playability becomes something like "space lander" hard hehe
Maybe version 2 could use more complex object handling.
Funny thing is if you want mouse to work in the console, one option would be porting from FreeBasic to QB4.5 and using asm routines.
QB4.5 asm mouse driver code
'$INCLUDE: 'QB.BI'
DIM SHARED regs AS regtypex
setupmouse:
PRINT "Setting up mouse..."
LET regs.ax = 0
CALL INTERRUPTX(51, regs, regs)
LET regs.ax = 1
CALL INTERRUPTX(51, regs, regs)
RETURN
readmouse:
LET regs.ax = 3
CALL INTERRUPTX(51, regs, regs)
LET mousex = INT(regs.cx/8)+1
LET mousey = INT(regs.dx/8)+1
LET mouseb = regs.bx
RETURN
It's already setup to read the console by dividing the x and y pos by 8 (the size of a character). mousex, mousey, and mouseb contain the mouse data. I've used this for a number of old programs.
oh but that's system specific... as i said... it would work on console if including my "ConsoleAuxiliar.bas" that implements the "setmouse" (for the console)
it's just that freebasic setmouse does not work on the console on windows because they didnt implemented it for it (similar as screenevent), but i will submit a patch with the implementation :)