NeoCL v1.1b has been released!

[v3cz0r]

I'm posting the code here as i'm getting a "Internal Server Error" at bad-logic's forum when i try reply to your msg, weird..

-----------------------------

Sure, i used it in most of CS2D's modules, it's limited 'coz if there's no enough space, it will simply skip a new node being added.. that's ok for games, but with other algos.. redim preserve would help. (to get the code to compile with qb 4.5, delete the byval's)


queue.bas:

Code:

Option Explicit

DefInt a-z
'$include: 'queue.bi'


'':::::
Sub listInit( l as TLIST, lTB() as LNODE, byval maxnodes as integer )
    Dim i as integer

    ReDim lTB( 0 to maxnodes-1 ) as LNODE

    '' put all into the free list
    For i = 0 to maxnodes-1
        lTB(i).prv = i-1
        lTB(i).nxt = i+1
    Next i
    lTB(maxnodes-1).nxt = -1

    l.fhead    = 0
    l.head     = -1
    l.tail     = -1
    l.nodes    = maxnodes

End Sub

'':::::
Sub listEnd( l as TLIST, lTB() as LNODE )

    erase lTB

    l.head     = -1
    l.tail     = -1
    l.nodes    = 0

End Sub

'':::::
Sub listClear( l as TLIST, lTB() as LNODE )
    Dim i as integer

    For i = 0 to l.nodes-1
        lTB(i).prv = i-1
        lTB(i).nxt = i+1
    Next i
    lTB(l.nodes-1).nxt = -1

    l.fhead = 0
    l.head     = -1
    l.tail     = -1

End Sub

'':::::
Function listAdd%( l as TLIST, lTB() as LNODE, byval idx as integer ) Static
    Dim n as integer, nn as integer, i as integer

    ''
    listAdd = -1

    '' take from free list
    if( l.fhead = -1 ) then
        exit function
    end if

    n = l.fhead
    nn = lTB(n).nxt
    l.fhead = nn
    if( nn <> -1 ) then
        lTB(nn).prv = -1
    end if

    '' add to used list
    lTB(n).idx     = idx
    lTB(n).prv    = l.tail
    lTB(n).nxt    = -1

    If( l.tail <> -1 ) Then
        lTB(l.tail).nxt = n
    else
        l.head = n
    End if

    l.tail = n

    ''
    listAdd = n

End Function

'':::::
Sub listDel( l as TLIST, lTB() as LNODE, byval n as integer ) Static
    Dim pn as integer, nn as integer

    '' delete from used list
    pn = lTB(n).prv
    nn = lTB(n).nxt
    If( pn <> -1 ) Then
        lTB(pn).nxt = nn
    Else
        l.head = nn
    End if

    If( nn <> -1 ) Then
        lTB(nn).prv = pn
    Else
        l.tail = pn
    End if

    '' add to free list
    nn = l.fhead
    lTB(n).prv = -1
    lTB(n).nxt = nn
    if( nn <> -1 ) then
        lTB(nn).prv = n
    end if
    l.fhead = n

End Sub

'':::::
Function listGetFirst%( l as TLIST, lTB() as LNODE ) static

    listGetFirst = -1

    l.curr = l.head
    if( l.curr = -1 ) then Exit Function

    listGetFirst = lTB(l.curr).idx

end function

'':::::
Function listGetNext%( l as TLIST, lTB() as LNODE ) static

    listGetNext = -1

    if( l.curr = -1 ) then Exit Function

    l.curr = lTB(l.curr).nxt
    if( l.curr = -1 ) then Exit Function

    listGetNext = lTB(l.curr).idx

end function

queue.bi:

Code:

type TLIST
    head    as integer
    tail    as integer
    fhead    as integer
    nodes    as integer

    curr    as integer
end type

Type LNODE
    idx        as integer
    prv        as integer
    nxt        as integer
End Type


declare Sub         listInit        ( l as TLIST, lTB() as LNODE, byval maxnodes as integer )

declare Sub         listEnd            ( l as TLIST, lTB() as LNODE )

declare Sub         listClear        ( l as TLIST, lTB() as LNODE )

declare Function     listAdd%        ( l as TLIST, lTB() as LNODE, byval idx as integer )

declare Sub         listDel            ( l as TLIST, lTB() as LNODE, byval n as integer )

declare Function     listGetFirst%    ( l as TLIST, lTB() as LNODE )

declare Function     listGetNext%    ( l as TLIST, lTB() as LNODE )

usage example:

Code:

'$include: 'queue.bi'

const MAXITEMS%        = 100

type ITEM
    id            as integer
    stat        as integer
    
    ln            as integer                        '' linked-list node
end type


'' globals
dim shared itemlist as TLIST

redim shared itemTB( 0 ) as ITEM

redim shared lTB( 0 ) as LNODE


''::::
sub itemInit
    dim i as integer

    redim itemTB( 0 to MAXITEMS-1 ) as ITEM

    listInit itemlist, lTB(), MAXITEMS

    '' set to invalid
    for i = 0 to MAXITEMS-1
        itemTB(i).ln = -1
    next i

end sub

''::::
sub itemEnd

    erase itemTB

    listEnd itemlist, lTB()

end sub

'':::::
function newItem% static
    static i as integer
    dim ln as integer

    if( itemTB(i).ln <> -1 ) then
        listDel itemlist, lTB(), itemTB(i).ln
        itemTB(i).ln = -1
    end if

    '' find a free slot
    ln = listAdd( itemlist, lTB(), i )
    if( ln = -1 ) then
        newItem = -1
        exit function
    end if

    '' save list node for fast deletion later..
    itemTB(i).ln = ln

    newItem = i

    '' this will only work if nodes are always deleted after being used
    i = (i + 1) mod MAXITEMS

end function


'':::::
sub itemAdd( byval id as integer, byval stat as integer ) static
    dim i as integer

    i = newItem
    if( i = -1 ) then exit sub

    '' save
    itemTB(i).id = id
    itemTB(i).stat = stat
    
end sub

''::::
sub itemUpdateAll static
    dim i as integer, n as integer

    i = listGetFirst( itemlist, lTB() )
    do until( i = -1 )
        n = listGetNext( itemlist, lTB() )

        if( itemTB(i).stat = 0 ) then
            listDel itemlist, lTB(), itemTB(i).ln
            itemTB(i).ln = -1
        end if

        i = n
    loop

end sub