Spade Ships game

[mysoft]

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

[Lucidapogee]

Screenshot attached.

Interesting mechanics. Gotta really move fast.

It would be crazy if each level had another npc.

[mysoft]

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

[Lucidapogee]

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.

[mysoft]

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