Roguelike walk around demo with simple field of view

User projects written in or related to FreeBASIC.
elsairon
Posts: 207
Joined: Jul 02, 2005 14:51

Roguelike walk around demo with simple field of view

Postby elsairon » Jan 09, 2008 21:57

There have been some questions about RL's lately, so here is a little console mode RL walk around demo I made today to test a different field of view algorithm for my RL. This one casts rays from the player only to the bounding edges of the map rather than every space, so its a bit faster.

It builds a 20 x 20 map and randomly places 20 wall spaces on it, and starts the player on a random space.

Commands are displayed in teh program.

This was tested on U.S. keyboard on winxp using fbc 18.3 -lang fb

I think it's fairly clear code, but if you have any questions ask :)

Latest Version (Updated 15 JAN 2008)
Latest version of the RL walk around demo. This one uses graphics mode and offers several enhancements including; more accurate shadow-casting; fast multi-key input with controlled delay and repeat values, fixed and scrolling map views, and field of view that adapts to the current size of the visible map (improving speed when possible). Original included below for comparison.

Code: Select all

' Roguelike 'walk-around' example
'
' Demonstrates:
' - field of view with shadowcasting using line-of-sight raytracing
' - scrolling and fixed mapviews
'
' feel free to use as you like - Elsairon

#include "fbgfx.bi"

Const As Integer yes = 1, _
                 no  = 0, _
                 shadow = 2, _
                 maxcol = 20, _
                 maxrow = 20, _
                 walls =  20, _
                 floor = 3, _
                 wall  = 4, _
                 viewrad = 6, _
                 viewmax = ( viewrad * 2 ) + 1, _
                 view_fixed = 0, _
                 view_scroll = 1
                 
Const As String floor_symbol =  ".", _
                wall_symbol =   "#", _
                player_symbol = "@"

Dim Shared As Integer player_row, _
                      player_col, _
                      map( 1 To maxrow , 1 To maxcol ), _
                      losmap( 1 To maxrow , 1 To maxcol ), _
                      view_type, los_scans
                     

Declare Function los( Byref As Integer, Byref As Integer, Byref As Integer, Byref As Integer ) As Integer
Declare Sub init_display
Declare Sub init_player
Declare Sub init_map
Declare Sub show_map
Declare Sub clear_map_viewport
Declare Sub toggle_view
Declare Sub show_scrolled_map
Declare Sub show_player
Declare Sub show_info
Declare Sub calc_fov
Declare Sub player_command
Declare Sub move_north
Declare Sub move_south
Declare Sub move_east
Declare Sub move_west



Sub init_display
   
    Screen 17
    Width 80, 25
   
End Sub



Function los _
    ( _
            Byref x1 As Integer, _
            Byref y1 As Integer, _
            Byref x2 As Integer, _
            Byref y2 As Integer _
    ) As Integer
   
    ' Starts los at x1, y1 and advances to x2, y2
    ' using Bresenham's integer line algorithm
   
    Dim As Integer deltax, deltay, x, y, den, _
                 curspace, num, numadd, length, _
                 xinc1, yinc1, xinc2, yinc2, dx, dy, _
                 losflag
   
    deltax = Abs( x2 - x1 )
    deltay = Abs( y2 - y1 )
    x = x1
    y = y1
    If x2 >= x1 Then
        xinc1 = 1
        xinc2 = 1
    Else
        xinc1 = -1
        xinc2 = -1
    End If
    If y2 >= y1 Then
        yinc1 = 1
        yinc2 = 1
    Else
        yinc1 = -1
        yinc2 = -1
    End If
    If deltax >= deltay Then
        xinc1 = 0
        yinc2 = 0
        den = 2 * deltax
        num = deltax
        numadd = 2 * deltay
        length = deltax
    Else
        xinc2 = 0
        yinc1 = 0
        den = 2 * deltay
        num = deltay
        numadd = 2 * deltax
        length = deltay
    End If
   
    losflag = yes
    For curspace = 0 To length - 1
        num = num + numadd
        If num >= den Then
                num = num - den
                x = x + xinc1
                y = y + yinc1
        End If
        x = x + xinc2
        y = y + yinc2
       
        If losmap( x, y ) <> shadow Then
            losmap( x, y ) = losflag                   
            If losflag = yes And map( x, y ) = wall Then losflag = shadow
        End If
   
    Next curspace
   
    If x = x2 And y = y2 And losflag = yes Then Return 1
    Return 0
   
End Function



Sub init_map
   
    Dim As Integer x, y, wc, wr, count_walls
   
    ' cover map with floor
    For x = 1 To maxcol
        For y = 1 To maxrow
            map( x, y ) = floor
        Next y
    Next x
    ' make some random walls
    If walls And walls < maxcol * maxrow Then
        Do
            wc = Int(Rnd*maxcol)+1
            wr = Int(Rnd*maxrow)+1
            If map( wr, wc ) <> wall Then
                map( wr, wc ) = wall
                count_walls += 1
            End If
        Loop Until count_walls = walls
    Else
        ? "const walls invalid value = " & walls & "!"
        Sleep
        End
    End If
   
End Sub



Sub init_player
   
    Dim As Integer good_player_location
   
    ' locate player, ensure player does not start on a wall
    good_player_location = no
    Do
        player_col = Int ( Rnd * maxcol ) + 1
        player_row = Int ( Rnd * maxrow ) + 1
        If map( player_row, player_col ) <> wall Then good_player_location = yes
    Loop Until good_player_location = yes
   
End Sub



Sub clear_map_viewport
   
    Dim As Integer c, r
    For c = 1 To maxcol
        For r = 1 To maxrow
            Locate r, c
            Print " "
        Next r
    Next c
   
End Sub



Sub toggle_view
   
    Select Case view_type
    Case view_fixed: view_type = view_scroll
    Case Else:       view_type = view_fixed
    End Select
    clear_map_viewport
   
End Sub



Sub calc_fov
   
    Dim As Integer c, r, sc, ec, sr, er
   
    select case view_type
    case view_fixed
            'scan entire map
            sc = 1
            ec = maxcol
            sr = 1
            er = maxrow
    case view_scroll
            ' scan only visible portion of map
            sc = player_col - viewrad
            if sc < 1 then sc = 1
            ec = player_col + viewrad
            if ec > maxcol then ec = maxcol
            sr = player_row - viewrad
            if sr < 1 then sr = 1
            er = player_row + viewrad
            if er > maxrow then er = maxrow
    end select
   
    ' clear only fov for our current needs
    For c = sc To ec
        For r = sr To er
            losmap( r, c ) = no
        Next r
    Next c   
   
    los_scans = 0
   
    ' los from player to every col edge on first and last visible row
    For c = sc To ec
            los( player_row, player_col, sr, c )
            los( player_row, player_col, er, c )
            los_scans += 2
    Next c
   
    ' los from player to every row edge on first and last visible col
    ' (skip corners as we checked them above)
    For r = (sr + 1) To (er - 1)
            los( player_row, player_col, r, sc )
            los( player_row, player_col, r, ec )
            los_scans += 2
    Next r
   
End Sub



Sub show_map
   
    Dim As String mapchar
    Dim As Integer map_row, map_col
    For map_row = 1 To maxrow
            For map_col = 1 To maxcol
                    mapchar = " "
                    If losmap( map_row, map_col ) = yes Then
                            Select Case map( map_row, map_col )
                            Case wall : mapchar = wall_symbol
                            Case floor : mapchar = floor_symbol
                            Case Else: 'nothing....
                            End Select
                    End If
                    Locate map_row,map_col
                    ? mapchar
            Next map_col
    Next map_row

End Sub


Function checkbounds _
    ( _
            Byref chk_row As Integer, _
            Byref chk_col As Integer _
    ) As Integer
   
    If chk_row < 1 Then Return 0
    If chk_row > maxrow Then Return 0
    If chk_col < 1 Then Return 0
    If chk_col > maxcol Then Return 0
    Return 1
   
End Function



Sub show_scrolled_map
   
    Dim As String mapchar
    Dim As Integer mRow, mCol
    For mRow = -viewrad To viewrad
        For mCol = -viewrad To viewrad
            mapchar = " "
            If checkbounds( mRow + player_row, mCol + player_col ) Then
                If losmap( mRow + player_row, mCol + player_col ) = yes Then
                    Select Case map ( mRow + player_row, mCol + player_col )
                    Case wall : mapchar = wall_symbol
                    Case Else : mapchar = floor_symbol
                    End Select
                End If
            End If
            Locate mRow + viewrad + 1, mCol + viewrad + 1
            ? mapchar
        Next mCol
    Next mRow
   
End Sub



Sub show_player

    Select Case view_type
    Case view_fixed     
        Locate 12,32: ? "Fixed Map    "
        Locate player_row, player_col
    Case view_scroll
        Locate 12,32: ? "Scrolling Map"
        Locate viewrad + 1, viewrad + 1
    End Select
    ? player_symbol   
    Locate 13,32: ? player_row & " "
    Locate 14,32: ? player_col & " "       
    locate 15,32: ? los_scans & "  "
   
End Sub



Sub show_info
   
    Locate 01,25: ? "  ---===||||| COMMANDS |||||===---  "
    Locate 02,25: ? "-------------------------------------"
    Locate 03,25: ? "   Up -  Move North"
    Locate 04,25: ? " Down -  Move South"
    Locate 05,25: ? " Left -  Move West"
    Locate 06,25: ? "Right -  Move East"
    Locate 03,47: ? "Esc - Exit Test"
    Locate 04,47: ? "  V - Swap View"
    Locate 05,47: ? "  M - New Map"
    Locate 07,25: ? "-------------------------------------"

    Locate 10,25: ? "   ---===||| INFORMATION |||===---  "
    Locate 11,25: ? "-------------------------------------"
    Locate 12,49: ? " " & player_symbol & "  -  Player"
    Locate 13,49: ? " " & floor_symbol & "  -  Floor"
    Locate 14,49: ? " " & wall_symbol & "  -  Wall"
   
    Locate 12,25: ? "View:"
    Locate 13,25: ? "Row :"
    Locate 14,25: ? "Col :"
    locate 15,25: ? "Rays:"
    Locate 16,25: ? "-------------------------------------"
   
End Sub



Sub move_north
   
    ' don't move north if on north edge of map or if a wall is in the way
    If player_row > 1 Then
        If map( player_row - 1, player_col ) <> wall Then
            player_row -= 1
        End If
    End If

End Sub


   
Sub move_south
   
    ' don't move south if on south edge of map or if a wall is in the way
    If player_row < maxrow Then
        If map( player_row + 1, player_col ) <> wall Then
            player_row += 1
        End If
    End If

End Sub



Sub move_west
   
    ' don't move west if on west edge of map or if a wall is in the way
    If player_col > 1 Then
        If map( player_row, player_col - 1 ) <> wall Then
            player_col -= 1
        End If
    End If

End Sub



Sub move_east
   
    ' don't move east if on east edge of map or if a wall is in the way
    If player_col < maxcol Then
        If map( player_row, player_col + 1 ) <> wall Then
            player_col += 1
        End If
    End If

End Sub

   

Sub player_command
   
    Static trap As Integer
    Static last_command As Integer
    Static repeat As Integer
    Static last_event As Double
    Dim As Double delay, trap_wait, repeat_wait, time_start
   
    trap_wait = .3
    repeat_wait = .06
    time_start = Timer
   
    If time_start - last_event > repeat_wait + .02 Or trap <> last_command Then
        repeat = -1
        delay = trap_wait
    Elseif trap = repeat Then
        delay = repeat_wait
    End If
   
    If trap Then
        last_command = trap
        ' wait until the key is released before trying another key
        While Multikey( trap )
            ' break out early if the key is held down long enough
            If Timer - time_start > delay Then
                repeat = trap
                Exit While
            End If
        Wend
    End If

    trap = 0
    last_event = Timer

    Do
        If Multikey(FB.SC_ESCAPE) Then Cls: End
        If Multikey(FB.SC_V     ) Then toggle_view : trap = FB.SC_V : Exit Do       
        If Multikey(FB.SC_M     ) Then init_map: init_player: trap = FB.SC_M: Exit Do
        If Multikey(FB.SC_LEFT  ) Then move_west:  trap = FB.SC_LEFT  : Exit Do
        If Multikey(FB.SC_RIGHT ) Then move_east:  trap = FB.SC_RIGHT : Exit Do
        If Multikey(FB.SC_UP    ) Then move_north: trap = FB.SC_UP    : Exit Do
        If Multikey(FB.SC_DOWN  ) Then move_south: trap = FB.SC_DOWN  : Exit Do
        ' ensure some free cpu cycles
        Sleep 1, 1
    Loop

End Sub

' initalization
init_display
init_map
init_player
show_info

' main loop
Do
    calc_fov
    Screenlock
        Select Case view_type
        Case view_fixed  : show_map
        Case view_scroll : show_scrolled_map
        End Select
        show_player
    Screenunlock
    player_command
Loop


Original Version
Original (console mode) demo with fixes.
EDIT: Fixed hang when pressing non command key
EDIT: 'Hide' cursor (move it to bottom and off to the side after display)

Code: Select all

' RogueLike walk-around demo
'
' uses Bresenhams line algorithm for raycasting field of view
'
' adjust 'walls' const to change number of random wall cell generated

const yes = 1
const no  = 0
const maxcol = 20
const maxrow = 20
const walls =  20
const floor = 3
const wall  = 4

const floor_symbol =  "."
const wall_symbol =   "#"
const player_symbol = "@"

' keycodes for player input tracking
' support upper and lower case for player ease
const ESCAPE =      27
const KEY_8 =       56
const KEY_4 =       52
const KEY_6 =       54
const KEY_2 =       50
const KEY_LOWER_H = 104
const KEY_UPPER_H = 72
const KEY_LOWER_J = 106
const KEY_UPPER_J = 74
const KEY_LOWER_K = 107
const KEY_UPPER_K = 75
const KEY_LOWER_L = 108
const KEY_UPPER_L = 76
const KEY_UPPER_M = 77
const KEY_LOWER_M = 109
const KEY_LEFT =    331
const KEY_RIGHT =   333
const KEY_UP =      328
const KEY_DOWN =    336

dim shared as integer player_row, player_column

dim shared map( 1 to maxrow , 1 to maxcol ) as integer 'holds terrain info
dim shared losmap( 1 to maxrow , 1 to maxcol ) as integer 'holds line of sight info

declare function los( as integer, as integer, as integer, as integer ) as integer
declare function keypress_code() as integer
declare sub init_player
declare sub init_map
declare sub show_map
declare sub show_player
declare sub show_info
declare sub calc_fov
declare sub player_command
declare sub move_north
declare sub move_south
declare sub move_east
declare sub move_west



function los _
    ( _
            byval x1 as integer, _
            byval y1 as integer, _
            byval x2 as integer, _
            byval y2 as integer _
    ) as integer
 
  ' Starts los at x1, y1 and advances to x2, y2
  ' using Bresenham's integer line algorithm

  dim as integer deltax, deltay, x, y, den, _
                 curspace, num, numadd, length, _
                 xinc1, yinc1, xinc2, yinc2, dx, dy
 
  deltax = abs( x2 - x1 )
  deltay = abs( y2 - y1 )
  x = x1
  y = y1
  if x2 >= x1 then
        xinc1 = 1
        xinc2 = 1
  else
        xinc1 = -1
        xinc2 = -1
  end if
  if y2 >= y1 then
        yinc1 = 1
        yinc2 = 1
  else
        yinc1 = -1
        yinc2 = -1
  end if
  if deltax >= deltay then
        xinc1 = 0
        yinc2 = 0
        den = 2 * deltax
        num = deltax
        numadd = 2 * deltay
        length = deltax
  else
        xinc2 = 0
        yinc1 = 0
        den = 2 * deltay
        num = deltay
        numadd = 2 * deltax
        length = deltay
  end if
  for curspace = 0 to length - 1
        num = num + numadd
        if num >= den then
                num = num - den
                x = x + xinc1
                y = y + yinc1
        end if
        x = x + xinc2
        y = y + yinc2
       
        losmap( x, y ) = yes
               
        if map( x, y ) = wall then return 0
        if x = x2 and y = y2 then return 1
  next curspace
 
  return 0
 
end function



sub init_map
   
    dim as integer x, y, wc, wr, count_walls
   
    ' cover map with floor
    for x = 1 to maxcol
        for y = 1 to maxrow
            map( x, y ) = floor
        next y
    next x
    ' make some random walls
    if walls and walls < maxcol * maxrow then
        do
            wc = int(rnd*maxcol)+1
            wr = int(rnd*maxrow)+1
            if map( wr, wc ) <> wall then
                map( wr, wc ) = wall
                count_walls += 1
            end if
        loop until count_walls = walls
    else
        ? "const walls invalid value = " & walls & "!"
        sleep
        end
    end if
   
end sub



sub init_player
   
    dim as integer good_player_location
   
    ' locate player, ensure player does not start on a wall
    good_player_location = no
    do
        player_column = int ( rnd * maxcol ) + 1
        player_row = int ( rnd * maxrow ) + 1
        if map( player_row, player_column ) <> wall then good_player_location = yes
    loop until good_player_location = yes
   
end sub



sub calc_fov
   
    dim as integer c, r
   
    ' clear the previous fov
    for c = 1 to maxcol
        for r = 1 to maxrow
            losmap( r, c ) = no
        next r
    next c   
   
    ' los ray from player location to every column edge on the first and last row
    for c = 1 to maxcol
        los( player_row, player_column,      1, c )
        los( player_row, player_column, maxrow, c )
    next c
    ' los ray from player location to every row edge on first and last column
    ' (skipping the corners because we already checked those above )
    for r = 2 to maxrow - 1
        los( player_row, player_column, r,      1 )
        los( player_row, player_column, r, maxcol )
    next r
   
end sub



sub show_map
   
    dim as string mapchar
    dim as integer x, y
   
    ' draw map
    for x = 1 to maxrow
        for y = 1 to maxcol
            mapchar = " "
            if losmap( x, y ) = yes then
               
                select case map( x, y )
                case wall : mapchar = wall_symbol
                case else : mapchar = floor_symbol
                end select
               
            end if
            locate x,y
            ? mapchar
        next y
    next x

end sub



sub show_player

    locate player_row, player_column
    ? player_symbol
   
end sub



sub show_info
   
    ' show commands
    locate 01,30: ? "COMMAND LIST"
    locate 03,30: ? "Keypress  Function"
    locate 04,30: ? "--------- ------------"
    locate 05,30: ? "Esc ..... Exit Program"
    locate 06,30: ? "M ....... New Map"
    locate 07,30: ? "h,4,Left  Move West"
    locate 08,30: ? "j,8,Up .. Move North"
    locate 09,30: ? "k,2,Down  Move South"
    locate 10,30: ? "l,6,Right Move East"
   
    ' show mapkey
    locate 14,30: ? "MAP KEY"
    locate 16,30: ? "Symbol  Meaning"
    locate 17,30: ? "------  -------"
    locate 18,30: ? "  " & wall_symbol & "     Wall"
    locate 19,30: ? "  " & floor_symbol & "     Floor"
    locate 20,30: ? "  " & player_symbol & "     Player"
   
end sub



sub move_north
   
    ' don't move north if on north edge of map or if a wall is in the way
    if player_row > 1 then
        if map( player_row - 1, player_column ) <> wall then
            player_row -= 1
        end if
    end if

end sub


   
sub move_south
   
    ' don't move south if on south edge of map or if a wall is in the way
    if player_row < maxrow then
        if map( player_row + 1, player_column ) <> wall then
            player_row += 1
        end if
    end if

end sub



sub move_west
   
    ' don't move west if on west edge of map or if a wall is in the way
    if player_column > 1 then
        if map( player_row, player_column - 1 ) <> wall then
            player_column -= 1
        end if
    end if

end sub



sub move_east
   
    ' don't move east if on east edge of map or if a wall is in the way
    if player_column < maxcol then
        if map( player_row, player_column + 1 ) <> wall then
            player_column += 1
        end if
    end if

end sub



function keypress_code as integer

    dim as integer keylength, keycode, keypress
    dim as string keybuffer
   
    keypress = no
   
    do
        keybuffer = inkey
        keylength = len( keybuffer )
        if keylength then
            keycode = asc( right( keybuffer, 1 ) )
            if keylength = 2 then keycode += 256
            keypress = yes
        end if
        ' keep some cpu cycles free
        sleep 1
    loop until keypress = yes

    return keycode
   
end function

   

sub player_command

    dim as integer good_input, test_input
   
    do
        good_input = yes
        test_input = keypress_code
        select case test_input
        case ESCAPE
            end
           
        case KEY_8, KEY_UP, KEY_UPPER_J, KEY_LOWER_J
            move_north
           
        case KEY_4, KEY_LEFT, KEY_UPPER_H, KEY_LOWER_H
            move_west
           
        case KEY_6, KEY_RIGHT, KEY_UPPER_L, KEY_LOWER_L
            move_east
           
        case KEY_2, KEY_DOWN, KEY_UPPER_K, KEY_LOWER_K
            move_south
           
        case KEY_UPPER_M, KEY_LOWER_M
            init_map
            init_player
           
        case else
                good_input = no
        end select
       
    loop until good_input = yes
   
end sub



init_map
init_player
show_info

' main game loop
do
    calc_fov
    show_map
    show_player

    ' hack move the cursor to 'hide' it
    locate 20,60
    ' /hack

    player_command
loop
Last edited by elsairon on Jan 15, 2008 4:00, edited 9 times in total.
mambazo
Posts: 652
Joined: Jul 17, 2005 13:02
Location: Ireland
Contact:

Postby mambazo » Jan 09, 2008 22:17

EDIT:- My post had no relevance :)
Last edited by mambazo on Jan 10, 2008 12:55, edited 1 time in total.
Lachie Dazdarian
Posts: 2338
Joined: May 31, 2005 9:59
Location: Croatia
Contact:

Postby Lachie Dazdarian » Jan 09, 2008 22:20

Numpad controls don't work on my PC. And the game is overall quite unresponsive. Why did you choose to work in the console window which doesn't allow you to use MULTIKEY?

I like the light ray casting thing.
mambazo
Posts: 652
Joined: Jul 17, 2005 13:02
Location: Ireland
Contact:

Postby mambazo » Jan 09, 2008 22:25

Lachie Dazdarian wrote:Numpad controls don't work on my PC. And the game is overall quite unresponsive. Why did you choose to work in the console window which doesn't allow you to use MULTIKEY?

I like the light ray casting thing.


In the tradition of Rogue (1980), true Roguelikes are turn based, in that, the player makes 1 move, then the 'world' makes one move. Multikey defeats that :P

Also, elsairon has presented an example for newcomers to Roguelikes. Its not a full featured action game, its an example :)

@elsairon: Nice FOV code. I did notice that the code hung after a while though. Not sure why :S
elsairon
Posts: 207
Joined: Jul 02, 2005 14:51

Postby elsairon » Jan 09, 2008 23:29

I'll take a look at the issues, although I have not had either issue:

a) slow response
b) hanging
c) numpad controls not working (I wrote and tested on a laptop which may have something to do with this)

It's mainly to show the fov, with little else to keep the progam easy to follow.

Thanks for the feedback.

edit..

@Lachie : Are you using a US keyboard or a different one?

@mambazo: Any idea what might have caused this.. I have tested this quite a bit with no hangs here. There are no pointers or memory swapping going on. I'll try to figure it out.
KristopherWindsor
Posts: 2428
Joined: Jul 19, 2006 19:17
Location: Sunnyvale, CA
Contact:

Postby KristopherWindsor » Jan 10, 2008 1:42

You should hide the blinking cursor (with Locate). ;-)
mambazo
Posts: 652
Joined: Jul 17, 2005 13:02
Location: Ireland
Contact:

Postby mambazo » Jan 10, 2008 12:44

I've heard that Vista's console mode, with FB at least, can be very sluggish. Perhaps that is what that problem is?

It wasn't sluggish for me (WinXP)
badmrbox
Posts: 659
Joined: Oct 27, 2005 14:40
Location: Sweden
Contact:

Postby badmrbox » Jan 10, 2008 15:28

I'm running Vista and I didn't find it sluggish really.
I noticed that the demo hangs when you hit any key that isn't used by the program.
Nice stuff :).
elsairon
Posts: 207
Joined: Jul 02, 2005 14:51

RL walk around + fov demo update

Postby elsairon » Jan 10, 2008 15:56

Program updated to use graphics mode and multi-key. This should solve the sluggishness and cursor issues (but introduces some others..)

Info display tweaked for clarity, additional move commands 'wasd' added.

A quick test with multikey however, reveals that the player still makes miltiple moves, and cannot be controlled accurately, even when explicity clearing the keybuffer and using sleep 100 between moves! !

For example, sometimes the player does a double move with one keystroke. Slowing the routine down any further makes it sluggish, but speeding it up creates more and more multi-moves, which does not work for a turn based game in which every keystroke can be important.

If someone can write a multikey input routine that can get explicit keystroke events, I'd like to see it.

EDIT: Add relevant quote here
Lachie Dazdarian wrote:Numpad controls don't work on my PC.


The main draw for using multikey for this is the statement 'guaranteed to be supported in all platforms' that is made in the docs in reference to multikey. If we could use inkey with the same defined guarantee of support (for keyboard events), that would work much better for this.

Might the SC_... fbgfx.bi key events be used with inkey or getkey?

Code follows...

Code: Select all

' RogueLike walk-around demo
'
' uses Bresenhams line algorithm for raycasting field of view
'
' adjust 'walls' const to change number of random wall cell generated

' changed to graphic mode for no cursor, multi-key support
#include "fbgfx.bi"

const yes = 1
const no  = 0
const maxcol = 20
const maxrow = 20
const walls =  20
const floor = 3
const wall  = 4

const floor_symbol =  "."
const wall_symbol =   "#"
const player_symbol = "@"

dim shared as integer player_row, player_column, map( 1 to maxrow , 1 to maxcol )
dim shared losmap( 1 to maxrow , 1 to maxcol ) as integer

declare function los( as integer, as integer, as integer, as integer ) as integer
declare sub init_display
declare sub init_player
declare sub init_map
declare sub show_map
declare sub show_player
declare sub show_info
declare sub calc_fov
declare sub player_command
declare sub move_north
declare sub move_south
declare sub move_east
declare sub move_west



sub init_display
   
    screen 16
    width 64, 24
   
end sub



function los _
    ( _
            byval x1 as integer, _
            byval y1 as integer, _
            byval x2 as integer, _
            byval y2 as integer _
    ) as integer
 
  ' Starts los at x1, y1 and advances to x2, y2
  ' using Bresenham's integer line algorithm

  dim as integer deltax, deltay, x, y, den, _
                 curspace, num, numadd, length, _
                 xinc1, yinc1, xinc2, yinc2, dx, dy
 
  deltax = abs( x2 - x1 )
  deltay = abs( y2 - y1 )
  x = x1
  y = y1
  if x2 >= x1 then
        xinc1 = 1
        xinc2 = 1
  else
        xinc1 = -1
        xinc2 = -1
  end if
  if y2 >= y1 then
        yinc1 = 1
        yinc2 = 1
  else
        yinc1 = -1
        yinc2 = -1
  end if
  if deltax >= deltay then
        xinc1 = 0
        yinc2 = 0
        den = 2 * deltax
        num = deltax
        numadd = 2 * deltay
        length = deltax
  else
        xinc2 = 0
        yinc1 = 0
        den = 2 * deltay
        num = deltay
        numadd = 2 * deltax
        length = deltay
  end if
  for curspace = 0 to length - 1
        num = num + numadd
        if num >= den then
                num = num - den
                x = x + xinc1
                y = y + yinc1
        end if
        x = x + xinc2
        y = y + yinc2
       
        losmap( x, y ) = yes
               
        if map( x, y ) = wall then return 0
        if x = x2 and y = y2 then return 1
  next curspace
 
  return 0
 
end function



sub init_map
   
    dim as integer x, y, wc, wr, count_walls
   
    ' cover map with floor
    for x = 1 to maxcol
        for y = 1 to maxrow
            map( x, y ) = floor
        next y
    next x
    ' make some random walls
    if walls and walls < maxcol * maxrow then
        do
            wc = int(rnd*maxcol)+1
            wr = int(rnd*maxrow)+1
            if map( wr, wc ) <> wall then
                map( wr, wc ) = wall
                count_walls += 1
            end if
        loop until count_walls = walls
    else
        ? "const walls invalid value = " & walls & "!"
        sleep
        end
    end if
   
end sub



sub init_player
   
    dim as integer good_player_location
   
    ' locate player, ensure player does not start on a wall
    good_player_location = no
    do
        player_column = int ( rnd * maxcol ) + 1
        player_row = int ( rnd * maxrow ) + 1
        if map( player_row, player_column ) <> wall then good_player_location = yes
    loop until good_player_location = yes
   
end sub



sub calc_fov
   
    dim as integer c, r
   
    ' clear the previous fov
    for c = 1 to maxcol
        for r = 1 to maxrow
            losmap( r, c ) = no
        next r
    next c   
   
    ' los ray from player location to every column edge on the first and last row
    for c = 1 to maxcol
        los( player_row, player_column,      1, c )
        los( player_row, player_column, maxrow, c )
    next c
    ' los ray from player location to every row edge on first and last column
    ' (skipping the corners because we already checked those above )
    for r = 2 to maxrow - 1
        los( player_row, player_column, r,      1 )
        los( player_row, player_column, r, maxcol )
    next r
   
end sub



sub show_map
   
    dim as string mapchar
    dim as integer x, y
   
    ' draw map
    for x = 1 to maxrow
        for y = 1 to maxcol
            mapchar = " "
            if losmap( x, y ) = yes then
               
                select case map( x, y )
                case wall : mapchar = wall_symbol
                case else : mapchar = floor_symbol
                end select
               
            end if
            locate x,y
            ? mapchar
        next y
    next x

end sub



sub show_player

    locate player_row, player_column
    ? player_symbol
   
end sub



sub show_info
   
    ' show commands
    locate 01,25: ? "COMMAND LIST"
    locate 03,25: ? "Keypress        Function"
    locate 04,25: ? "--------        ---------"
    locate 05,25: ? "Esc ..........  Exit Test"
    locate 06,25: ? "M ............  New Map"
    locate 07,25: ? "H, A, 4, Left   Move West"
    locate 08,25: ? "J, W, 8, Up ..  Move North"
    locate 09,25: ? "K, S, 2, Down   Move South"
    locate 10,25: ? "L, D, 6, Right  Move East"
   
    ' show mapkey
    locate 13,25: ? "MAP KEY"
    locate 15,25: ? "Symbol  Meaning"
    locate 16,25: ? "------  -------"
    locate 17,25: ? "  " & wall_symbol & "     Wall"
    locate 18,25: ? "  " & floor_symbol & "     Floor"
    locate 19,25: ? "  " & player_symbol & "     Player"
   
end sub



sub move_north
   
    ' don't move north if on north edge of map or if a wall is in the way
    if player_row > 1 then
        if map( player_row - 1, player_column ) <> wall then
            player_row -= 1
        end if
    end if

end sub


   
sub move_south
   
    ' don't move south if on south edge of map or if a wall is in the way
    if player_row < maxrow then
        if map( player_row + 1, player_column ) <> wall then
            player_row += 1
        end if
    end if

end sub



sub move_west
   
    ' don't move west if on west edge of map or if a wall is in the way
    if player_column > 1 then
        if map( player_row, player_column - 1 ) <> wall then
            player_column -= 1
        end if
    end if

end sub



sub move_east
   
    ' don't move east if on east edge of map or if a wall is in the way
    if player_column < maxcol then
        if map( player_row, player_column + 1 ) <> wall then
            player_column += 1
        end if
    end if

end sub

 

sub player_command
    ' we want only a single event at a time (assume a turn-based game)
    ' so wait for a keypress, do the action, and then exit
    do
        if multikey(FB.SC_ESCAPE) then cls: end
       
        if multikey(FB.SC_M     ) then init_map: init_player: exit do
       
        if multikey(FB.SC_H     ) then move_west:  exit do
        if multikey(FB.SC_4     ) then move_west:  exit do
        if multikey(FB.SC_LEFT  ) then move_west:  exit do
        if multikey(FB.SC_A     ) then move_west:  exit do
       
        if multikey(FB.SC_L     ) then move_east:  exit do
        if multikey(FB.SC_6     ) then move_east:  exit do
        if multikey(FB.SC_RIGHT ) then move_east:  exit do
        if multikey(FB.SC_D     ) then move_east:  exit do
       
        if multikey(FB.SC_J     ) then move_north: exit do
        if multikey(FB.SC_8     ) then move_north: exit do
        if multikey(FB.SC_UP    ) then move_north: exit do
        if multikey(FB.SC_W     ) then move_north: exit do
       
        if multikey(FB.SC_K     ) then move_south: exit do
        if multikey(FB.SC_2     ) then move_south: exit do
        if multikey(FB.SC_DOWN  ) then move_south: exit do
        if multikey(FB.SC_S     ) then move_south: exit do
       
        ' sleep to ensure some free cpu cycles
        sleep 1
    loop
   
    ' flush keybuffer input .. we want only one command per loop
    ' tests show multikey is still too fast even when clearing the buffer
    do
      sleep 1
    loop while len( inkey ) > 0
   
    ' try to slow down so we can get discrete key events with multikey
    sleep 100
   
end sub

' initalization

init_display
init_map
init_player
show_info

' main loop
do
    calc_fov
    show_map
    show_player
    player_command
loop


Edit: spelling
Last edited by elsairon on Jan 10, 2008 17:02, edited 2 times in total.
elsairon
Posts: 207
Joined: Jul 02, 2005 14:51

Postby elsairon » Jan 10, 2008 16:02

In original console demo in first post:

- program hang error fixed (initialize variable in command loop, was wrongly outside)
- added cursor 'hiding' hack
mambazo
Posts: 652
Joined: Jul 17, 2005 13:02
Location: Ireland
Contact:

Postby mambazo » Jan 10, 2008 18:03

elsairon wrote:If someone can write a multikey input routine that can get explicit keystroke events, I'd like to see it.


This is possible.

Code: Select all

dim as integer isHeld

isHeld = 0

do
   if multikey(whatever) and not(isHeld) then

       ? "Button is pressed"
       isHeld = 1

   end if

   'if no buttons are being pressed
   isHeld = 0

loop




Its pseudo code but you get the idea. I used a similar principal in an old beat'em'up game.
elsairon
Posts: 207
Joined: Jul 02, 2005 14:51

Postby elsairon » Jan 10, 2008 18:55

Here is another test.

Multikey input is used to set a flag variable.

The flag is used in a switch to initiate the games functions.

The flag variable and the keybuffer is cleared in each input loop iteration, and it still produces multiple moves!.

I conclude (so far), the best course will use inkey for turn based roguelike user input.

The test.

Code: Select all

' RogueLike walk-around demo
'
' uses Bresenhams line algorithm for raycasting field of view
'
' adjust 'walls' const to change number of random wall cell generated

' changed to graphic mode for no cursor, multi-key support version 2
#include "fbgfx.bi"

const yes = 1
const no  = 0
const maxcol = 20
const maxrow = 20
const walls =  20
const floor = 3
const wall  = 4

const floor_symbol =  "."
const wall_symbol =   "#"
const player_symbol = "@"

enum actions
    do_nothing
    do_move_north
    do_move_south
    do_move_east
    do_move_west
    do_exit_game
    do_new_map
end enum

dim shared as integer player_row, player_column, map( 1 to maxrow , 1 to maxcol )
dim shared losmap( 1 to maxrow , 1 to maxcol ) as integer

declare function los( as integer, as integer, as integer, as integer ) as integer
declare sub init_display
declare sub init_player
declare sub init_map
declare sub show_map
declare sub show_player
declare sub show_info
declare sub calc_fov
declare sub player_command
declare sub move_north
declare sub move_south
declare sub move_east
declare sub move_west



sub init_display
   
    screen 16
    width 64, 24
   
end sub



function los _
    ( _
            byval x1 as integer, _
            byval y1 as integer, _
            byval x2 as integer, _
            byval y2 as integer _
    ) as integer
 
  ' Starts los at x1, y1 and advances to x2, y2
  ' using Bresenham's integer line algorithm

  dim as integer deltax, deltay, x, y, den, _
                 curspace, num, numadd, length, _
                 xinc1, yinc1, xinc2, yinc2, dx, dy
 
  deltax = abs( x2 - x1 )
  deltay = abs( y2 - y1 )
  x = x1
  y = y1
  if x2 >= x1 then
        xinc1 = 1
        xinc2 = 1
  else
        xinc1 = -1
        xinc2 = -1
  end if
  if y2 >= y1 then
        yinc1 = 1
        yinc2 = 1
  else
        yinc1 = -1
        yinc2 = -1
  end if
  if deltax >= deltay then
        xinc1 = 0
        yinc2 = 0
        den = 2 * deltax
        num = deltax
        numadd = 2 * deltay
        length = deltax
  else
        xinc2 = 0
        yinc1 = 0
        den = 2 * deltay
        num = deltay
        numadd = 2 * deltax
        length = deltay
  end if
  for curspace = 0 to length - 1
        num = num + numadd
        if num >= den then
                num = num - den
                x = x + xinc1
                y = y + yinc1
        end if
        x = x + xinc2
        y = y + yinc2
       
        losmap( x, y ) = yes
               
        if map( x, y ) = wall then return 0
        if x = x2 and y = y2 then return 1
  next curspace
 
  return 0
 
end function



sub init_map
   
    dim as integer x, y, wc, wr, count_walls
   
    ' cover map with floor
    for x = 1 to maxcol
        for y = 1 to maxrow
            map( x, y ) = floor
        next y
    next x
    ' make some random walls
    if walls and walls < maxcol * maxrow then
        do
            wc = int(rnd*maxcol)+1
            wr = int(rnd*maxrow)+1
            if map( wr, wc ) <> wall then
                map( wr, wc ) = wall
                count_walls += 1
            end if
        loop until count_walls = walls
    else
        ? "const walls invalid value = " & walls & "!"
        sleep
        end
    end if
   
end sub



sub init_player
   
    dim as integer good_player_location
   
    ' locate player, ensure player does not start on a wall
    good_player_location = no
    do
        player_column = int ( rnd * maxcol ) + 1
        player_row = int ( rnd * maxrow ) + 1
        if map( player_row, player_column ) <> wall then good_player_location = yes
    loop until good_player_location = yes
   
end sub



sub calc_fov
   
    dim as integer c, r
   
    ' clear the previous fov
    for c = 1 to maxcol
        for r = 1 to maxrow
            losmap( r, c ) = no
        next r
    next c   
   
    ' los ray from player location to every column edge on the first and last row
    for c = 1 to maxcol
        los( player_row, player_column,      1, c )
        los( player_row, player_column, maxrow, c )
    next c
    ' los ray from player location to every row edge on first and last column
    ' (skipping the corners because we already checked those above )
    for r = 2 to maxrow - 1
        los( player_row, player_column, r,      1 )
        los( player_row, player_column, r, maxcol )
    next r
   
end sub



sub show_map
   
    dim as string mapchar
    dim as integer x, y
   
    ' draw map
    for x = 1 to maxrow
        for y = 1 to maxcol
            mapchar = " "
            if losmap( x, y ) = yes then
               
                select case map( x, y )
                case wall : mapchar = wall_symbol
                case else : mapchar = floor_symbol
                end select
               
            end if
            locate x,y
            ? mapchar
        next y
    next x

end sub



sub show_player

    locate player_row, player_column
    ? player_symbol
   
end sub



sub show_info
   
    ' show commands
    locate 01,25: ? "COMMAND LIST"
    locate 03,25: ? "Keypress        Function"
    locate 04,25: ? "--------        ---------"
    locate 05,25: ? "Esc ..........  Exit Test"
    locate 06,25: ? "M ............  New Map"
    locate 07,25: ? "H, A, 4, Left   Move West"
    locate 08,25: ? "J, W, 8, Up ..  Move North"
    locate 09,25: ? "K, S, 2, Down   Move South"
    locate 10,25: ? "L, D, 6, Right  Move East"
   
    ' show mapkey
    locate 13,25: ? "MAP KEY"
    locate 15,25: ? "Symbol  Meaning"
    locate 16,25: ? "------  -------"
    locate 17,25: ? "  " & wall_symbol & "     Wall"
    locate 18,25: ? "  " & floor_symbol & "     Floor"
    locate 19,25: ? "  " & player_symbol & "     Player"
   
end sub



sub move_north
   
    ' don't move north if on north edge of map or if a wall is in the way
    if player_row > 1 then
        if map( player_row - 1, player_column ) <> wall then
            player_row -= 1
        end if
    end if

end sub


   
sub move_south
   
    ' don't move south if on south edge of map or if a wall is in the way
    if player_row < maxrow then
        if map( player_row + 1, player_column ) <> wall then
            player_row += 1
        end if
    end if

end sub



sub move_west
   
    ' don't move west if on west edge of map or if a wall is in the way
    if player_column > 1 then
        if map( player_row, player_column - 1 ) <> wall then
            player_column -= 1
        end if
    end if

end sub



sub move_east
   
    ' don't move east if on east edge of map or if a wall is in the way
    if player_column < maxcol then
        if map( player_row, player_column + 1 ) <> wall then
            player_column += 1
        end if
    end if

end sub

 

sub player_command
    ' we want only a single event at a time (assume a turn-based game)
    ' so wait for a keypress, do the action, and then exit
    dim as integer player_action
    do
        ' flush keybuffer input .. we want only one command per loop
        player_action = do_nothing
        do
            sleep 1
        loop while len( inkey ) > 0
       
        if multikey(FB.SC_ESCAPE) then player_action = do_exit_game:  exit do
       
        if multikey(FB.SC_M     ) then player_action = do_new_map:    exit do
       
        if multikey(FB.SC_H     ) then player_action = do_move_west:  exit do
        if multikey(FB.SC_4     ) then player_action = do_move_west:  exit do
        if multikey(FB.SC_LEFT  ) then player_action = do_move_west:  exit do
        if multikey(FB.SC_A     ) then player_action = do_move_west:  exit do
       
        if multikey(FB.SC_L     ) then player_action = do_move_east:  exit do
        if multikey(FB.SC_6     ) then player_action = do_move_east:  exit do
        if multikey(FB.SC_RIGHT ) then player_action = do_move_east:  exit do
        if multikey(FB.SC_D     ) then player_action = do_move_east:  exit do
       
        if multikey(FB.SC_J     ) then player_action = do_move_north: exit do
        if multikey(FB.SC_8     ) then player_action = do_move_north: exit do
        if multikey(FB.SC_UP    ) then player_action = do_move_north: exit do
        if multikey(FB.SC_W     ) then player_action = do_move_north: exit do
       
        if multikey(FB.SC_K     ) then player_action = do_move_south: exit do
        if multikey(FB.SC_2     ) then player_action = do_move_south: exit do
        if multikey(FB.SC_DOWN  ) then player_action = do_move_south: exit do
        if multikey(FB.SC_S     ) then player_action = do_move_south: exit do
       
        ' sleep to ensure some free cpu cycles
        sleep 1
    loop
   
    select case player_action
    case do_exit_game : cls: end
    case do_new_map   : init_map: init_player
    case do_move_north: move_north
    case do_move_south: move_south
    case do_move_east : move_east
    case do_move_west : move_west
    case else:       ' do nothing
    end select

   
end sub

' initalization

init_display
init_map
init_player
show_info

' main loop
do
    calc_fov
    show_map
    show_player
    player_command
loop


The problem then becomes, how to support different keyboards using inkey?
KristopherWindsor
Posts: 2428
Joined: Jul 19, 2006 19:17
Location: Sunnyvale, CA
Contact:

Postby KristopherWindsor » Jan 10, 2008 21:12

The reason for using Multikey is smooth animation. If you want to make the character move 1 space / position for each key press, you should still use Inkey.
I posted a demo a few months ago, for how to draw in console mode without flicker, and how to use Multikey for smooth motion (without testing for new key presses like in Mambazo's example), here:
http://www.freebasic.net/forum/viewtopic.php?t=9310
(The trick is to not make the character move an entire position every time Multikey is detected, because that would be too fast.)

BTW, that demo runs fine for me, on Vista, so ASCII graphics in console mode can work well if you use them correctly. ;-)
elsairon
Posts: 207
Joined: Jul 02, 2005 14:51

Postby elsairon » Jan 10, 2008 21:43

Smooth animation is not needed with turn based one key one action RL demo ;) My main concern for testing multikey was to get support for all keyboards.

Predefined scancodes for Inkey seem to break for different users (I assume because of different keyboard layouts). I'll probably have to add in some kind of OS dependant keyboard detection, or use a library that can handle keyboards well... dropping support for numpad keys is not an options since I want to support numpad keys.

I checked out the little program link. Much less flicker, nice. If I go on and write a full-fledged RL console tutorial I may use it. However using graphics mode solves that.

Thanks for the feedback.
KristopherWindsor
Posts: 2428
Joined: Jul 19, 2006 19:17
Location: Sunnyvale, CA
Contact:

Postby KristopherWindsor » Jan 10, 2008 22:15

Maybe Lachie's "Num Lock" button is broken and the light is stuck on. It is an old computer... :-P

Return to “Projects”

Who is online

Users browsing this forum: Majestic-12 [Bot] and 6 guests