FreeBASIC Community produced game

General discussion for topics related to the FreeBASIC project or its community.
Post Reply
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: FreeBASIC Community produced game

Post by dodicat »

paul doe wrote:Here's a simple example of the Observer Pattern, implemented using a push protocol. It's quite simple but serves to illustrate the pattern and its use:

Code: Select all

/'
  Observer pattern
'/

'' We need this to forward reference the Observer interface
type _Observer as Observer
'' Null for objects
#define NIL cptr( any ptr, 0 )

/'
  Context interface
 
  This interface defines the context for the notification, that is,
  the parameters for the message sent to the listener. It empty
  because it will vary with each individual context (which, in turn,
  depend on the interests of each observer).
  The default constructor is declared protected: to avoid direct
  instantiation of this class.
'/
type Context extends Object
  public:
    declare virtual destructor()
 
  protected:
    declare constructor()
end type

constructor Context()
end constructor

destructor Context()
end destructor

/'
  Subject interface
 
  This interface defines the 'subject' of the pattern, that is, the
  object that acts as the message dispatch service. Observers subscribe
  to receive notifications from him.
'/
type Subject extends Object
  public:
    declare virtual destructor()
   
    declare abstract sub subscribe( _
      byref as _Observer )
    declare abstract sub unsubscribe()
    declare abstract sub sendMessage( _
      byref as Context )
 
  protected:
    declare constructor()
end type

constructor Subject()
end constructor

destructor Subject()
end destructor

/'
  Observer interface
 
  This is the interface that defines the 'observers' of the pattern. They
  subscribe to receive notifications from a 'subject' when needed.
'/
type Observer extends Object
  public:
    declare virtual destructor()
   
    declare abstract sub receiveMessage( _
      byref as Context )
   
  protected:
    declare constructor()
end type

constructor Observer()
end constructor

destructor Observer()
end destructor

/'
  A concrete implementation of a context. In this case, all it does is
  store a key pressed.
'/
type KeyboardContext extends Context
  public:
    declare constructor( _
      byval as ulong )
    declare destructor() override
   
    whichKey as ulong
  
  private:
    declare constructor()
end type

constructor KeyboardContext()
end constructor

constructor KeyboardContext( _
  byval aKey as ulong )
 
  whichKey = aKey
end constructor

destructor KeyboardContext()
end destructor

/'
  A concrete implementation of a subject. In this case, this is a
  simple keyboard handler that will send a message informing the
  subscribed observers of which key has been pressed. Here, there's
  support for a single observer, but this can be easily changed to
  support more than one observer per subject (by maintaining a list
  of observers).
'/
type KeyboardSubject extends Subject
  public:
    declare constructor()
    declare destructor() override
    
    declare property done() as boolean
    
    declare sub subscribe( _
      byref as Observer ) override
    declare sub unsubscribe() override
    declare sub sendMessage( _
      byref as Context ) override
 
    declare sub update()
   
  private:
    m_observer as Observer ptr
    m_done as boolean
end type

constructor KeyboardSubject()
end constructor

destructor KeyboardSubject()
end destructor

property KeyboardSubject.done() as boolean
  return( m_done )
end property

sub KeyboardSubject.subscribe( _
  byref anObserver as Observer )
 
  m_observer = @anObserver
end sub

sub KeyboardSubject.unsubscribe()
  m_observer = NIL
end sub

sub KeyboardSubject.sendMessage( _
  byref aContext as Context )
 
  if( m_observer <> NIL ) then
    m_observer->receiveMessage( aContext )
  end if
end sub

sub KeyboardSubject.update()
  dim as string k = inkey()
 
  if( len( k ) > 0 ) then
    sendMessage( KeyboardContext( asc( k ) ) )
  end if
  
  if( k = chr( 27 ) ) then
    m_done = true
  end if
end sub

/'
  And this is a concrete implementation of an observer. Here, it
  simply listens to messages forwarded by its subject, and prints
  some text when it receives one.
'/
type KeyboardObserver extends Observer
  public:
    declare constructor()
    declare destructor() override
   
    declare sub receiveMessage( _
      byref as Context ) override
end type

constructor KeyboardObserver()
end constructor

destructor KeyboardObserver()
end destructor

sub KeyboardObserver.receiveMessage( _
  byref aContext as Context )
 
  ? "A key has been pressed!"
  var aKey = cptr( _
    KeyboardContext ptr, @aContext )->whichKey
 
  ? "ASCII code: "; aKey
end sub

/'
  Main code
'/
var theSubject = KeyboardSubject()
var theObserver = KeyboardObserver()

theSubject.subscribe( theObserver )

do
  '' Allow the subject to do any processing it needs
  theSubject.update()
 
  sleep( 1, 1 )
  '' Loops until the observer signals it's done
loop until( theSubject.done )
All that abstraction for only half the story.
another layer for arrow keys e.t.c.;

Code: Select all

 /'
  Observer pattern
'/

'' We need this to forward reference the Observer interface
type _Observer as Observer
'' Null for objects
#define NIL cptr( any ptr, 0 )

/'
  Context interface
 
  This interface defines the context for the notification, that is,
  the parameters for the message sent to the listener. It empty
  because it will vary with each individual context (which, in turn,
  depend on the interests of each observer).
  The default constructor is declared protected: to avoid direct
  instantiation of this class.
'/
type Context extends Object
  public:
    declare virtual destructor()
 
  protected:
    declare constructor()
end type

constructor Context()
end constructor

destructor Context()
end destructor

/'
  Subject interface
 
  This interface defines the 'subject' of the pattern, that is, the
  object that acts as the message dispatch service. Observers subscribe
  to receive notifications from him.
'/
type Subject extends Object
  public:
    declare virtual destructor()
   
    declare abstract sub subscribe( _
      byref as _Observer )
    declare abstract sub unsubscribe()
    declare abstract sub sendMessage( _
      byref as Context )
 
  protected:
    declare constructor()
end type

constructor Subject()
end constructor

destructor Subject()
end destructor

/'
  Observer interface
 
  This is the interface that defines the 'observers' of the pattern. They
  subscribe to receive notifications from a 'subject' when needed.
'/
type Observer extends Object
  public:
    declare virtual destructor()
   
    declare abstract sub receiveMessage( _
      byref as Context )
   
  protected:
    declare constructor()
end type

constructor Observer()
end constructor

destructor Observer()
end destructor

/'
  A concrete implementation of a context. In this case, all it does is
  store a key pressed.
'/
type KeyboardContext extends Context
  public:
    declare constructor( _
      byval as ulong )
    declare destructor() override
   
    whichKey as ulong
  
  private:
    declare constructor()
end type

constructor KeyboardContext()
end constructor

constructor KeyboardContext( _
  byval aKey as ulong )
 
  whichKey = aKey
end constructor

destructor KeyboardContext()
end destructor

/'
  A concrete implementation of a subject. In this case, this is a
  simple keyboard handler that will send a message informing the
  subscribed observers of which key has been pressed. Here, there's
  support for a single observer, but this can be easily changed to
  support more than one observer per subject (by maintaining a list
  of observers).
'/
type KeyboardSubject extends Subject
  public:
    declare constructor()
    declare destructor() override
    
    declare property done() as boolean
    
    declare sub subscribe( _
      byref as Observer ) override
    declare sub unsubscribe() override
    declare sub sendMessage( _
      byref as Context ) override
 
    declare sub update()
   
  private:
    m_observer as Observer ptr
    m_done as boolean
end type

constructor KeyboardSubject()
end constructor

destructor KeyboardSubject()
end destructor

property KeyboardSubject.done() as boolean
  return( m_done )
end property

sub KeyboardSubject.subscribe( _
  byref anObserver as Observer )
 
  m_observer = @anObserver
end sub

sub KeyboardSubject.unsubscribe()
  m_observer = NIL
end sub

sub KeyboardSubject.sendMessage( _
  byref aContext as Context )
 
  if( m_observer <> NIL ) then
    m_observer->receiveMessage( aContext )
  end if
end sub

sub KeyboardSubject.update()
    #define mk(a,b) a or b shl 16
  dim as string k = inkey()
  dim as long k1,k2,k3
  if len(k) then
   k1=k[0]:k2=k[1]
   k3=mk(k1,k2)
  end if
  
 
  if( len( k ) > 0 ) then
      sendMessage( KeyboardContext( k3 ) )
    ''sendMessage( KeyboardContext( asc( k ) ) )
  end if
  
  if( k = chr( 27 ) ) then
    m_done = true
  end if
end sub

/'
  And this is a concrete implementation of an observer. Here, it
  simply listens to messages forwarded by its subject, and prints
  some text when it receives one.
'/
type KeyboardObserver extends Observer
  public:
    declare constructor()
    declare destructor() override
   
    declare sub receiveMessage( _
      byref as Context ) override
end type

constructor KeyboardObserver()
end constructor

destructor KeyboardObserver()
end destructor

sub KeyboardObserver.receiveMessage( _
  byref aContext as Context )
 
  ? "A key has been pressed!"
  var aKey = cptr( _
    KeyboardContext ptr, @aContext )->whichKey
 
  ? "ASCII code: "; loword(aKey),iif(hiword(aKey),str(hiword(aKey)),"")
end sub

/'
  Main code
'/
var theSubject = KeyboardSubject()
var theObserver = KeyboardObserver()

theSubject.subscribe( theObserver )

do
  '' Allow the subject to do any processing it needs
  theSubject.update()
 
  sleep( 1, 1 )
  '' Loops until the observer signals it's done
loop until( theSubject.done ) 
paul doe
Moderator
Posts: 1730
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: FreeBASIC Community produced game

Post by paul doe »

dodicat wrote:All that abstraction for only half the story.
And the point is?
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: FreeBASIC Community produced game

Post by dodicat »

Completing the story.

I don't disagree with oop for a game, I think procedural gets more and more complicated as the game evolves.
You might end up with flags on top of flags.
For a big project I would opt oop also.
Remembering of course that constructor/let calls e.t.c. all take time.
paul doe
Moderator
Posts: 1730
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: FreeBASIC Community produced game

Post by paul doe »

dodicat wrote:Completing the story.
This is not even the beginning of the story, but for completeness sake :sigh:

Code: Select all

/'
  Observer pattern
'/

'' We need this to forward reference the Observer interface
type _Observer as Observer
'' Null for objects
#define NIL cptr( any ptr, 0 )

/'
  Context interface
 
  This interface defines the context for the notification, that is,
  the parameters for the message sent to the listener. It empty
  because it will vary with each individual context (which, in turn,
  depend on the interests of each observer).
  The default constructor is declared protected: to avoid direct
  instantiation of this class.
'/
type Context extends Object
  public:
    declare virtual destructor()
 
  protected:
    declare constructor()
end type

constructor Context()
end constructor

destructor Context()
end destructor

/'
  Subject interface
 
  This interface defines the 'subject' of the pattern, that is, the
  object that acts as the message dispatch service. Observers subscribe
  to receive notifications from him.
'/
type Subject extends Object
  public:
    declare virtual destructor()
   
    declare abstract sub subscribe( _
      byref as _Observer )
    declare abstract sub unsubscribe()
    declare abstract sub sendMessage( _
      byref as Context )
 
  protected:
    declare constructor()
end type

constructor Subject()
end constructor

destructor Subject()
end destructor

/'
  Observer interface
 
  This is the interface that defines the 'observers' of the pattern. They
  subscribe to receive notifications from a 'subject' when needed.
'/
type Observer extends Object
  public:
    declare virtual destructor()
   
    declare abstract sub receiveMessage( _
      byref as Context )
   
  protected:
    declare constructor()
end type

constructor Observer()
end constructor

destructor Observer()
end destructor

/'
  A concrete implementation of a context. In this case, all it does is
  store a key pressed.
'/
type KeyboardContext extends Context
  public:
    declare constructor( _
      byval as ulong )
    declare destructor() override
   
    whichKey as ulong
 
  private:
    declare constructor()
end type

constructor KeyboardContext()
end constructor

constructor KeyboardContext( _
  byval aKey as ulong )
 
  whichKey = aKey
end constructor

destructor KeyboardContext()
end destructor

/'
  A concrete implementation of a subject. In this case, this is a
  simple keyboard handler that will send a message informing the
  subscribed observers of which key has been pressed. Here, there's
  support for a single observer, but this can be easily changed to
  support more than one observer per subject (by maintaining a list
  of observers).
'/
type KeyboardSubject extends Subject
  public:
    declare constructor()
    declare destructor() override
   
    declare property done() as boolean
   
    declare sub subscribe( _
      byref as Observer ) override
    declare sub unsubscribe() override
    declare sub sendMessage( _
      byref as Context ) override
 
    declare sub update()
   
  private:
    m_observer as Observer ptr
    m_done as boolean
end type

constructor KeyboardSubject()
end constructor

destructor KeyboardSubject()
end destructor

property KeyboardSubject.done() as boolean
  return( m_done )
end property

sub KeyboardSubject.subscribe( _
  byref anObserver as Observer )
 
  m_observer = @anObserver
end sub

sub KeyboardSubject.unsubscribe()
  m_observer = NIL
end sub

sub KeyboardSubject.sendMessage( _
  byref aContext as Context )
 
  if( m_observer <> NIL ) then
    m_observer->receiveMessage( aContext )
  end if
end sub

sub KeyboardSubject.update()
  dim as string k = inkey()
 
  if( len( k ) > 0 ) then
    sendMessage( KeyboardContext( _
      ( asc( k, 2 ) shl 16 ) or asc( k, 1 ) ) )
  end if
 
  if( k = chr( 27 ) ) then
    m_done = true
  end if
end sub

/'
  And this is a concrete implementation of an observer. Here, it
  simply listens to messages forwarded by its subject, and prints
  some text when it receives one.
'/
type KeyboardObserver extends Observer
  public:
    declare constructor()
    declare destructor() override
   
    declare sub receiveMessage( _
      byref as Context ) override
end type

constructor KeyboardObserver()
end constructor

destructor KeyboardObserver()
end destructor

sub KeyboardObserver.receiveMessage( _
  byref aContext as Context )
 
  ? "A key has been pressed!"
  var aKey = cptr( _
    KeyboardContext ptr, @aContext )->whichKey
 
  ? "ASCII code: "; loword( aKey ); " "; hiword( aKey )
end sub

/'
  Main code
'/
var theSubject = KeyboardSubject()
var theObserver = KeyboardObserver()

theSubject.subscribe( theObserver )

do
  '' Allow the subject to do any processing it needs
  theSubject.update()
 
  sleep( 1, 1 )
  '' Loops until the observer signals it's done
loop until( theSubject.done )
No need to use scary things like string indexing operators =D
dafhi
Posts: 1640
Joined: Jun 04, 2005 9:51

Re: FreeBASIC Community produced game

Post by dafhi »

dodimus must be losing it
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: FreeBASIC Community produced game

Post by BasicCoder2 »

I only have the nano45 files as a guide as to what is being proposed and am unsure of what the difference is going to be?
The nano45 files do not seem to have come with any instructions on how to use it or explanations of how to write an AI.
If more than one person works on the core code then surely they must agree on how to do it?
My understanding at this stage is individuals can design the AI of a space ship which then goes into a .bi file, eg coderJeff_ai.bi
This would mean anyone wanting to program such a ship would need to be shown how to do it.
Last edited by BasicCoder2 on Sep 02, 2018 21:12, edited 2 times in total.
grindstone
Posts: 862
Joined: May 05, 2015 5:35
Location: Germany

Re: FreeBASIC Community produced game

Post by grindstone »

coderJeff wrote:paul, I think you have direction in mind, and I think you should just go with it.
I agree.
grindstone
Posts: 862
Joined: May 05, 2015 5:35
Location: Germany

Re: FreeBASIC Community produced game

Post by grindstone »

BasicCoder2 wrote:My understanding at this stage is individuals can design the AI of a space ship which then goes into a .bi file, eg coderJeff_ai.bi
This would mean anyone wanting to program such a ship would need to be shown how to do it.
This raises the question: Shall the whole program (including all "pilots") run on one machine, or shall it be an online game, where the ships are controlled via the internet?
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: FreeBASIC Community produced game

Post by dodicat »

dafhi wrote:dodimus must be losing it
losing it Dafhi?
Could be.
Most likley.

Paul doe sighing is not a good omen (for such a simple code completion).
So early in the story as well!
dafhi
Posts: 1640
Joined: Jun 04, 2005 9:51

Re: FreeBASIC Community produced game

Post by dafhi »

always remember: there is a vast world beyond the cubby hole most of us paint ourselves in
paul doe
Moderator
Posts: 1730
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: FreeBASIC Community produced game

Post by paul doe »

dodicat wrote:Paul doe sighing is not a good omen (for such a simple code completion).
So early in the story as well!
Oh nonono don't get me wrong, I wasn't sighing because of your correction of a design oversight. But really, want to look at a 'real' implementation of an Observer? It is old, but this one has proven its worth on greener lands:

Code: Select all

#include once "datetime.bi"

namespace tgf
  const as any ptr NIL = cptr( any ptr, 0 )
  
  namespace collections
    type DisposeCallback as sub( byval as any ptr )
  end namespace
end namespace

type RGBAColor as ulong

namespace tgf
  namespace collections
    type LinkedListNode
      public:
        declare constructor( _
          byval as any ptr, _
          byval as DisposeCallback = NIL )
        
        declare destructor()
        
        item as any ptr
        
        forward as LinkedListNode ptr
        backward as LinkedListNode ptr
      
      private:
        declare constructor()
        
        m_disposeCallback as DisposeCallback
    end type
    
    constructor LinkedListNode()
    end constructor
    
    constructor LinkedListNode( _
      byval pItem as any ptr, _
      byval pDisposeCallback as DisposeCallback = NIL )
      
      item = pItem
      m_disposeCallback = pDisposeCallback
    end constructor
    
    destructor LinkedListNode()
      if( m_disposeCallback <> NIL ) then
        m_disposeCallback( item )
      end if
    end destructor
    
    type LinkedList extends Object
      public:
        declare constructor()
        declare destructor()
        
        declare property count() as integer
        declare property first() as LinkedListNode ptr
        declare property last() as LinkedListNode ptr
        
        declare function insertBefore( _
          byval as LinkedListNode ptr, _
          byval as any ptr, _
          byval as DisposeCallback = NIL ) as LinkedListNode ptr 
        
        declare function insertAfter( _
          byval as LinkedListNode ptr, _
          byval as any ptr, _
          byval as DisposeCallback = NIL ) as LinkedListNode ptr
        
        declare function insertBeginning( _
          byval as any ptr, _
          byval as DisposeCallback = NIL ) as LinkedListNode ptr
          
        declare function insertEnd( _
          byval as any ptr, _
          byval as DisposeCallback = NIL ) as LinkedListNode ptr
        
        declare function remove( _
          byval as LinkedListNode ptr ) as any ptr
        
        declare function removeFirst() as any ptr
        declare function removeLast() as any ptr
        
      private:
        m_last as LinkedListNode ptr
        m_first as LinkedListNode ptr
        
        m_count as integer
    end type
    
    constructor LinkedList()
    end constructor
    
    destructor LinkedList()
      do while( m_count > 0 )
        remove( m_last )
      loop
    end destructor
    
    property LinkedList.count() as integer
      return( m_count )
    end property
    
    property LinkedList.first() as LinkedListNode ptr
      return( m_first )
    end property
    
    property LinkedList.last() as LinkedListNode ptr
      return( m_last )
    end property
    
    function LinkedList.insertAfter( _
      byval node as LinkedListNode ptr, _
      byval pItem as any ptr, _
      byval pDisposeCallback as DisposeCallback = NIL ) as LinkedListNode ptr
      
      var newNode = new LinkedListNode( pItem, pDisposeCallback )
      
      newNode->backward = node
      newNode->forward = node->forward
      
      if( node->forward = NIL ) then
        m_last = newNode
      else
        node->forward->backward = newNode
      end if
      
      m_count += 1
      node->forward = newNode
      
      return( newNode )
    end function
    
    function LinkedList.insertBefore( _
      byval node as LinkedListNode ptr, _
      byval pItem as any ptr, _
      byval pDisposeCallback as DisposeCallback = NIL ) as LinkedListNode ptr
      
      var newNode = new LinkedListNode( pItem, pDisposeCallback )
      
      newNode->backward = node->backward
      newNode->forward = node
      
      if( node->backward = NIL ) then
        m_first = newNode
      else
        node->backward->forward = newNode
      end if
      
      m_count += 1
      node->backward = newNode
      
      return( newNode )
    end function
    
    function LinkedList.insertBeginning( _
      byval pItem as any ptr, _
      byval pDisposeCallback as DisposeCallback = NIL ) as LinkedListNode ptr
      
      if( m_first = NIL ) then
        var newNode = new LinkedListNode( pItem, pDisposeCallback )
        
        m_first = newNode
        m_last = newNode
        newNode->backward = NIL
        newNode->forward = NIL
        
        m_count += 1
        
        return( newNode )
      else
        return( insertBefore( m_first, pItem, pDisposeCallback ) )
      end if
    end function
    
    function LinkedList.insertEnd( _
      byval pItem as any ptr, _
      byval pDisposeCallback as DisposeCallback = NIL ) as LinkedListNode ptr
      
      if( m_last = NIL ) then
        return( insertBeginning( pItem, pDisposeCallback ) )
      else
        return( insertAfter( m_last, pItem, pDisposeCallback ) )
      end if
    end function
    
    function LinkedList.remove( _
      byval node as LinkedListNode ptr ) as any ptr
    
      dim as any ptr ret = NIL
      
      if( m_count > 0 ) then
        ret = node->item
        
        if( node->backward = NIL ) then
          m_first = node->forward
        else
          node->backward->forward = node->forward
        end if
        
        if( node->forward = NIL ) then
          m_last = node->backward
        else
          node->forward->backward = node->backward
        end if
        
        m_count -= 1
        delete( node )
      end if
      
      return( ret )
    end function
    
    function LinkedList.removeFirst() as any ptr
      return( remove( m_first ) )
    end function
    
    function LinkedList.removeLast() as any ptr
      return( remove( m_last ) )
    end function

    type StringTableEntry
      public:
        declare constructor( _
          byref as const string, _
          byval as any ptr, _
          byval as DisposeCallback = NIL )
        
        declare destructor()
        
        key as string
        value as any ptr
        
      private:
        declare constructor()
        
        m_disposeCallback as DisposeCallback
    end type
    
    constructor StringTableEntry()
    end constructor
    
    constructor StringTableEntry( _
      byref aKey as const string, _
      byval aValue as any ptr, _
      byval aDisposeCallback as DisposeCallback = NIL )
      
      key = aKey
      value = aValue
      m_disposeCallback = aDisposeCallback
    end constructor
    
    destructor StringTableEntry()
      if( m_disposeCallback <> NIL ) then
        m_disposeCallback( value )
      end if
    end destructor
    
    type StringHashTable
      public:
        declare constructor()
        declare constructor( byval as integer )
        declare destructor()
        
        declare property size() as integer
        declare property count() as integer
        declare property bucket( byval as integer ) as LinkedList ptr
        
        declare function findEntry( _
          byref as const string ) as StringTableEntry ptr
        
        declare sub addEntry( _
          byref as const string, _
          byval as any ptr, _
          byval as DisposeCallback = NIL )
        
        declare sub addEntry( _
          byval as StringTableEntry ptr )
      
        declare function removeEntry( _
          byref as const string ) as any ptr
        
        declare sub resize( byval as integer )
        
      private:
        declare constructor( byref as StringHashTable )
        declare operator let( byref as StringHashTable )
        declare sub initialize()
        declare static sub disposeEntry( byval as any ptr )
        
        declare function hash( byref as const string ) as ulong
        declare function findBucket( _
          byref as const string ) as LinkedList ptr
        
        m_size as integer
        m_entryCount as integer
        
        m_buckets( any ) as LinkedList ptr
    end type
    
    constructor StringHashTable()
      m_size = 256
      
      initialize()
    end constructor
    
    constructor StringHashTable( byval aSize as integer )
      m_size = iif( aSize < 16, 16, aSize )
      
      initialize()
    end constructor
    
    constructor StringHashTable( byref rhs as StringHashTable )
    end constructor
    
    operator StringHashTable.let( byref rhs as StringHashTable )
    end operator
    
    destructor StringHashTable()
      for i as integer = 0 to m_size - 1
        if( m_buckets( i ) <> NIL ) then
          delete( m_buckets( i ) )
        end if
      next
    end destructor
    
    sub StringHashTable.initialize()
      redim m_buckets( 0 to m_size - 1 )
      
      m_entryCount = 0
    end sub
    
    sub StringHashTable.disposeEntry( byval anEntry as any ptr )
      delete( cptr( StringTableEntry ptr, anEntry ) )
    end sub
    
    function StringHashTable.hash( byref aKey as const string ) as ulong
      dim as ulong h
      
      for i as integer = 0 to len( aKey ) - 1
        h = ( h shl 4 ) xor ( h shr 28 ) xor aKey[ i ]
      next
      
      return( h )
    end function
    
    property StringHashTable.size() as integer
      return( m_size )
    end property
    
    property StringHashTable.count() as integer
      return( m_entryCount )
    end property
    
    property StringHashTable.bucket( byval index as integer ) as LinkedList ptr
      return( m_buckets( index ) )
    end property
    
    function StringHashTable.findBucket( _
      byref aKey as const string ) as LinkedList ptr
      
      return( m_buckets( hash( aKey ) mod m_size ) )
    end function
    
    function StringHashTable.findEntry( _
      byref aKey as const string ) as StringTableEntry ptr
      
      dim as StringTableEntry ptr entry = NIL
      
      var iBucket = findBucket( aKey )
      
      if( iBucket <> NIL ) then
        var n = iBucket->last
        
        do while( n <> NIL )
          if( cptr( StringTableEntry ptr, n->item )->key = aKey ) then
            entry = n->item
            exit do
          end if
          
          n = n->backward
        loop
      end if
      
      return( entry )
    end function
    
    sub StringHashTable.addEntry( _
      byval anEntry as StringTableEntry ptr )
      
      dim as integer bucketNumber = hash( anEntry->key ) mod m_size
      
      if( m_buckets( bucketNumber ) = NIL ) then
        m_buckets( bucketNumber ) = new LinkedList()
        m_buckets( bucketNumber )->insertEnd( _
          anEntry, @disposeEntry )
      else
        m_buckets( bucketNumber )->insertEnd( _
          anEntry, @disposeEntry )
      end if
      
      m_entryCount += 1
    end sub
    
    sub StringHashTable.addEntry( _
      byref aKey as const string, _
      byval aValue as any ptr, _
      byval aDisposeCallback as DisposeCallback = NIL )
      
      dim as integer bucketNumber = hash( aKey ) mod m_size
      
      if( m_buckets( bucketNumber ) = NIL ) then
        m_buckets( bucketNumber ) = new LinkedList()
        m_buckets( bucketNumber )->insertEnd( _
          new StringTableEntry( aKey, aValue, aDisposeCallback ), @disposeEntry )
      else
        m_buckets( bucketNumber )->insertEnd( _
          new StringTableEntry( aKey, aValue, aDisposeCallback ), @disposeEntry )
      end if
      
      m_entryCount += 1
    end sub
    
    function StringHashTable.removeEntry( byref aKey as const string ) as any ptr
      dim as any ptr ret = NIL
      
      var iBucket = findBucket( aKey )
      
      if( iBucket <> NIL ) then
        var n = iBucket->last
        
        do while( n <> NIL )
          if( cptr( StringTableEntry ptr, n->item )->key = aKey ) then
            ret = cptr( StringTableEntry ptr, n->item )->value
            iBucket->remove( n )
            
            exit do
          end if
          
          n = n->backward
        loop
      end if
      
      m_entryCount -= 1
      return( ret )
    end function
    
    private sub StringHashTable.resize( byval newSize as integer )
      newSize = iif( newSize < 1, 1, newSize )
      
	    if( newSize < m_size ) then
		    for i as integer = newSize to m_size - 1
			    if( m_buckets( i ) <> NIL ) then
				    m_entryCount -= m_buckets( i )->count
				    
				    delete( m_buckets( i ) )
			    end if
		    next
	    end if
	    
	    m_size = newSize
	    redim preserve m_buckets( 0 to m_size - 1 )
    end sub
    
    type StringMap extends Object
      public:
        declare constructor()
        declare constructor( byval as integer )
        declare virtual destructor()
        
        declare property size() as integer
        declare property count() as integer
        
        declare sub add( _
          byref as const string, _
          byval as any ptr, _
          byval as DisposeCallback = NIL )
          
        declare function remove( byref as const string ) as any ptr
        declare function find( byref as const string ) as any ptr
        declare function findEntry( byref as const string ) as StringTableEntry ptr
        
      private:
        declare constructor( byref as StringMap )
        declare operator let( byref as StringMap )
        
        declare sub initialize()
        declare sub setResizeThresholds( _
          byval as integer, byval as single, byval as single )
        declare sub rehash( byval as integer )
        
        m_hashTable as StringHashTable ptr
        
        m_initialSize as integer
        m_maxThreshold as integer
        m_minThreshold as integer
    end type
    
    constructor StringMap()
      m_initialSize = 256
      initialize()
    end constructor
    
    constructor StringMap( byval aSize as integer )
      m_initialSize = aSize
      initialize()
    end constructor
    
    constructor StringMap( byref rhs as StringMap )
    end constructor
    
    operator StringMap.let( byref rhs as StringMap )
    end operator
    
    destructor StringMap()
      delete( m_hashTable )
    end destructor
    
    sub StringMap.initialize()
      m_hashTable = new StringHashTable( m_initialSize )
      
      setResizeThresholds( m_initialSize, 0.55, 0.85 )
    end sub
    
    property StringMap.size() as integer
      return( m_hashTable->size )
    end property
    
    property StringMap.count() as integer
      return( m_hashTable->count )
    end property
    
    function StringMap.find( byref aKey as const string ) as any ptr
      var entry = m_hashTable->findEntry( aKey )
      
      if( entry <> NIL ) then
        return( entry->value )
      else
        return( NIL )
      end if
    end function
    
    function StringMap.findEntry( byref aKey as const string ) as StringTableEntry ptr
      return( m_hashTable->findEntry( aKey ) )
    end function
    
    sub StringMap.add( _
      byref aKey as const string, _
      byval aValue as any ptr, _
      byval aDisposeCallback as DisposeCallback = NIL )
    
      m_hashTable->addEntry( aKey, aValue, aDisposeCallback )
      
      if( m_hashTable->count > m_maxThreshold ) then
        rehash( m_hashTable->size shl 1  )
      end if
    end sub
    
    function StringMap.remove( byref aKey as const string ) as any ptr
      dim as any ptr ret = m_hashTable->removeEntry( aKey )
      
      if( m_hashTable->count < m_minThreshold ) then
        rehash( m_hashTable->size shr 1 )
      end if
      
      return( ret )
    end function
    
    sub StringMap.setResizeThresholds( _
      byval newSize as integer, _
      byval lower as single, byval upper as single )
	    newSize = iif( newSize < m_initialSize, _
		    m_initialSize, newSize )
	    
	    dim as integer previousSize = newSize shr 1
	    
	    previousSize = iif( _
		    previousSize < m_initialSize, _
		    0, previousSize )
	    
	    m_minThreshold = int( previousSize * lower )
	    m_maxThreshold = int( newSize * upper )	
    end sub
    
    sub StringMap.rehash( byval newSize as integer )
      setResizeThresholds( newSize, 0.55, 0.85 )
      
      var newTable = new StringHashTable( newSize )
      
      for i as integer = 0 to m_hashTable->size - 1
        var b = m_hashTable->bucket( i )
        
        if( b <> NIL ) then
          var n = b->first
          
          do while( n <> NIL )
            newTable->addEntry( n->item )
            n->item = NIL
            n = n->forward
          loop
        end if
      next
      
      delete( m_hashTable )
      m_hashTable = newTable
    end sub
  end namespace
end namespace

type EventID as string

type IEventData extends Object
  public:
    declare virtual destructor()
    
    declare abstract property ID() as const EventID
    declare virtual property getName() as const string
    declare virtual property getTimestamp() as const double
    declare virtual function serialize() as string
    declare virtual function copy() as IEventData ptr
  
  protected:
    m_timestamp as double 
end type

destructor IEventData()
'  ? "IEventData::~IEventData()"
end destructor

property IEventData.getName() as const string
  return( "Unknown" )
end property

property IEventData.getTimestamp() as const double
  return( m_timestamp )
end property

function IEventData.serialize() as string
  return( "<Empty>" )
end function

function IEventData.copy() as IEventData ptr
  return( tgf.NIL )
end function

'#include once "../inc/tgf-string-map.bi"
'#include once "ecs-event-data.bi"

type EventListenerList as tgf.collections.LinkedList
type EventListenerMap as tgf.collections.StringMap
type EventListener as sub( byval as IEventData ptr )

type EventManager
  public:
    declare constructor()
    declare destructor()
    
    declare property eventCount() as integer
    declare function registerListener( _
      byval as any ptr, _
      byref as const EventID ) as boolean
    
    declare function unregisterListener( _
      byval as EventListener, _
      byref as const EventID ) as boolean
    
    declare function triggerEvent( _
      byval as IEventData ptr ) as boolean
      
    declare function queueEvent( _
      byval as IEventData ptr ) as boolean
    
    declare function abortEvent( _
      byref as const EventID, _
      byval as boolean = false ) as boolean
    
    declare function update( _
      byval as double = 0.0 ) as boolean
      
  private:
    declare function getEventListeners( _
      byref as const EventID ) as EventListenerList ptr
    
    declare function notify( _
      byval as EventListenerList ptr, _
      byval as IEventData ptr, _
      byval as boolean = false ) as boolean
      
    static m_NUM_QUEUES as const integer
    m_queues( any ) as EventListenerList ptr
    m_eventListeners as EventListenerMap ptr
    
    m_name as string
    m_activeQueue as integer
end type

dim as const integer EventManager.m_NUM_QUEUES = 2

constructor EventManager()
  redim m_queues( 0 to m_NUM_QUEUES - 1 )
  
  for i as integer = 0 to m_NUM_QUEUES - 1
    m_queues( i ) = new EventListenerList()
  next
  
  m_eventListeners = new EventListenerMap()
end constructor

destructor EventManager()
  '? "EventManager::~EventManager()"
  for i as integer = 0 to m_NUM_QUEUES - 1
    delete( m_queues( i ) )
  next
  
  delete( m_eventListeners )
end destructor

property EventManager.eventCount() as integer
  return( m_queues( m_activeQueue )->count )
end property

function EventManager.getEventListeners( _
  byref anID as const EventID ) as EventListenerList ptr
  
  return( m_eventListeners->find( anID ) )  
end function

function EventManager.notify( _
  byval theListeners as EventListenerList ptr, _
  byval anEvent as IEventData ptr, _
  byval deleteEvent as boolean = false ) as boolean
  
  dim as boolean notified = false
  
  if( theListeners <> tgf.NIL ) then
    var n = theListeners->first
    
    do while( n <> tgf.NIL )
      cptr( EventListener, n->item )( anEvent )
      n = n->forward
    loop
    
    if( deleteEvent = true ) then
      delete( anEvent )
    end if
    
    notified = true
  end if
  
  return( notified )
end function

function EventManager.registerListener( _
  byval aListener as any ptr, _
  byref anEventID as const EventID ) as boolean
  
  dim as boolean succeeded = true
  
  var listeners = getEventListeners( anEventID )
  
  if( listeners = tgf.NIL ) then
    listeners = new EventListenerList()    
    m_eventListeners->add( anEventID, listeners )
  else
    var n = listeners->first
    
    do while( n <> tgf.NIL )
      if( n->item = aListener ) then
        succeeded = false
        exit do
      end if
      
      n = n->forward
    loop
  end if
  
  if( succeeded ) then
    listeners->insertEnd( aListener )
  end if
  
  return( succeeded )
end function

function EventManager.unregisterListener( _
  byval aListener as EventListener, _
  byref anEventID as const EventID ) as boolean
  
  dim as boolean succeeded = false
  
  var listeners = getEventListeners( anEventID )
  
  if( listeners <> tgf.NIL ) then
    var n = listeners->first
    
    do while( n <> tgf.NIL )
      if( aListener = n->item ) then
        listeners->remove( n )
        
        succeeded = true
        exit do
      end if
      
      n = n->forward
    loop
  end if
  
  return( succeeded )
end function

function EventManager.triggerEvent( _
  byval anEvent as IEventData ptr ) as boolean
  
  return( notify( _
    getEventListeners( anEvent->ID ), anEvent ) )
end function

function EventManager.queueEvent( _
  byval anEvent as IEventData ptr ) as boolean
  
  dim as boolean succeeded = false
  var listeners = getEventListeners( anEvent->ID )
  
  if( listeners <> tgf.NIL ) then
    m_queues( m_activeQueue )->insertEnd( anEvent )
    succeeded = true
  end if
  
  return( succeeded )
end function

function EventManager.abortEvent( _
  byref anEventID as const EventID, _
  byval allEvents as boolean = false ) as boolean
  
  dim as boolean succeeded = false
  var listeners = getEventListeners( anEventID )
  
  if( listeners <> tgf.NIL ) then
    var queue = m_queues( m_activeQueue )
    var n = queue->last
    
    do while( n <> tgf.NIL )
      var nextNode = n->backward
      
      if( cptr( IEventData ptr, _
        n->item )->ID = anEventID ) then
        
        delete( cptr( _
          IEventData ptr, queue->remove( n ) ) )
        succeeded = true
        
        if( allEvents = false ) then
          exit do
        end if
      end if
        
      n = nextNode
    loop
  end if
  
  return( succeeded )
end function

function EventManager.update( _
  byval allotedTime as double = 0.0 ) as boolean
  
  dim as integer currentQueue = m_activeQueue
  m_activeQueue = ( m_activeQueue + 1 ) mod m_NUM_QUEUES
  
  dim as double currentTime = timer() * 1000
  dim as double limitTime = iif( allotedTime = 0.0, _
    0.0, currentTime + allotedTime )
    
  do while( m_queues( currentQueue )->count > 0 )
    dim as IEventData ptr event = _
      m_queues( currentQueue )->removeFirst()
    
    notify( getEventListeners( event->ID ), _
      event, true )
    
    currentTime = timer() * 1000
    
    if( limitTime > 0.0 andAlso _
      currentTime >= limitTime ) then
      exit do
    end if        
  loop
  
  dim as boolean queueFlushed = cbool( _
    m_queues( currentQueue )->count = 0 )
  
  if( queueFlushed = false ) then
    do while( m_queues( currentQueue )->count > 0 )
      m_queues( m_activeQueue )->insertEnd( _
        m_queues( currentQueue )->removeFirst() )
    loop
  end if
  
  return( queueFlushed )
end function

'#include once "ecs-event-manager.bi"

type Event1 extends IEventData
  public:
    declare constructor( byval as double )
    declare destructor() override
    
    declare property ID() as const EventID override
    declare property getName() as const string override
end type

constructor Event1( byval aTimestamp as double )
  m_timestamp = aTimestamp
end constructor

destructor Event1()
'  ? "Event1::~Event1()"
end destructor

property Event1.ID() as const EventID
  return( "Events:Event1" )
end property

property Event1.getName() as const string
  return( "Event1" )
end property

type Event2 extends IEventData
  public:
    declare constructor( byval as double )
    declare destructor() override
    
    declare property ID() as const EventID override
    declare property getName() as const string override
    
    x as integer = 3
    y as integer = 2
end type

constructor Event2( byval aTimestamp as double )
  m_timestamp = aTimestamp
  sleep( 5, 1 )
end constructor

destructor Event2()
'  ? "Event2::~Event2()"
end destructor

property Event2.ID() as const EventID
  return( "Events:Event2" )
end property

property Event2.getName() as const string
  return( "Event2" )
end property

sub EventHandler1( byval anEvent as Event1 ptr )
  ? "Handled event."
  ? anEvent->getTimestamp
  ? anEvent->getName
end sub

sub EventHandler2( byval anEvent as Event1 ptr )
  ? "EventHandler2 handled an event!"
end sub

sub EventHandler3( byval anEvent as Event2 ptr )
  ? "Another event handler"
  ? anEvent->x, anEvent->y
end sub

var em = new EventManager()

em->registerListener( @EventHandler1, Event1( 0 ).ID )
em->registerListener( @EventHandler2, Event1( 0 ).ID )
em->registerListener( @EventHandler3, Event2( 0 ).ID )

em->queueEvent( new Event2( Now() ) )
em->queueEvent( new Event1( Now() ) )
em->queueEvent( new Event1( -666.0 ) )

'em->abortEvent( "Events:Event1", true )

? "Triggering event:"
em->triggerEvent( @Event1( Now() ) )
'em->triggerEvent( @Event2( Now() ) )

dim as boolean result = em->update( 5.0 )

if( result = false ) then
  em->update()
end if

delete( em )

sleep()
Which is of course, a really convoluted, long and full of scary OOP sh*t way to do this:

Code: Select all

? "Triggering event:"
? "Handled event."
? " 43345.86454861111"
? "Event1"
? "EventHandler2 handled an event!"
? "Another event handler"
? " 3             2"
? "Handled event."
? " 43345.86453703704"
? "Event1"
? "EventHandler2 handled an event!"
? "Handled event."
? "-666"
? "Event1"
? "EventHandler2 handled an event!"

sleep()
I think that you'll understand it now. BTW, I removed every single comment that could guide the readers of the code, because nobody bothers to read them anyway.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: FreeBASIC Community produced game

Post by dodicat »

Dafhi
Reminds me of Somerset Maugham.
"Short therefore is life, and narrow is the corner in which we live it."
(One of his fictional sea captain's retorts)
And with that I have a real empathy.
Paul doe
Thank you.
The old ones are the best ones.
But on with the game now.
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: FreeBASIC Community produced game

Post by badidea »

This graphics style looks cool: http://erleuchtet.org/2008/03/project-o ... storm.html. Need to learn OpenGL now...
paul doe
Moderator
Posts: 1730
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: FreeBASIC Community produced game

Post by paul doe »

I found this today:

GladiaBots

Nice! Clean, simple and stylized visuals (albeit a bit dull), and uses similar ideas to what I had initially thought (although interpreted differently of course). Mmm, it seems that many developers on Steam are reading the same blog =D
coderJeff
Site Admin
Posts: 4313
Joined: Nov 04, 2005 14:23
Location: Ontario, Canada
Contact:

Re: FreeBASIC Community produced game

Post by coderJeff »

On the topic of "FreeBASIC Community produced game" I received this recent notification:
The Dark Bit Factory & Gravity Team wrote: Hi there coderJeff,

October is here, so it's time for another Halloween Challenge!

Be sure to check out the rules here:
http://www.dbfinteractive.com/forum/ind ... 8#msg84378

...and have fun!

Regards,
The Dark Bit Factory & Gravity Team.

http://www.dbfinteractive.com/forum/index.php
My idea would be, a simple shooting gallery type game. Mouse control, shoot the ghosts, pumpkins, tombstones, etc. For a high score. Can probably do it with simple fbgfx (pixel) graphics, and fbsound. Would be nice to have an honorable mention even if no prizes awarded for the effort. One way to keep FreeBASIC relevant is to get it on to other forums besides this one.
Post Reply