Results 1 to 5 of 5

Thread: A Stack of Quads

  1. #1
    thinBasic MVPs danbaron's Avatar
    Join Date
    Jan 2010
    Location
    California
    Posts
    1,378
    Rep Power
    152

    A Stack of Quads

    [font=courier new]Here is a script that implements a stack of Quads.


    Dan :P

    [code=thinbasic]'-----------------------------------------------------------------------------------------------------------------------
    'file = qstack.tbasicc
    '-----------------------------------------------------------------------------------------------------------------------
    Uses "console"
    '-----------------------------------------------------------------------------------------------------------------------

    'Implementation of a stack, to hold Quads.

    'As I bet you know, the name, "stack", comes from the analogy to a stack of plates.
    'The first plate, the one that you start a stack with (on the bottom), is the last plate that you remove from it.
    'The last plate, that you put on the top, is the first plate that you remove from it.
    'So, in computer science, a stack is a LIFO (last in first out) structure.
    '"push" means, "put a plate on the stack".
    '"pop" means, "remove a plate from the stack".
    'Here, "plate", means "Quad".

    'I made it to use with something else.
    'I did it without much thinking - instead, typing and changing until it seemed to work.
    'I know that is the lazy, unreliable way to do it; detail by detail, until,
    'it seems to magically do what it is supposed to do. In that case, the plus side is - it works,
    'the minus side is - you may not know how or why.

    'It could be buggy, but it seems to function OK.

    '-----------------------------------------------------------------------------------------------------------------------

    %quadsize = SizeOf(Quad)
    %nodesize = %quadsize + SizeOf(DWord)

    Global stack As DWord = 0

    '-----------------------------------------------------------------------------------------------------------------------

    Function TBMain()
    Local ss As DWord = 4
    Local i, j As Integer
    Local v As Quad

    For i = 1 To 2

    For j = -ss To ss
    push(j)
    Next

    For j = -ss To ss + 1
    If emptystack() Then
    Console_WriteLine("Stack empty.")
    Console_WriteLine()
    Else
    v = pop()
    Console_WriteLine(v)
    EndIf
    Next

    Next

    Console_WriteLine("Done. Press a key.")
    WaitKey
    End Function

    '-----------------------------------------------------------------------------------------------------------------------

    Function push(v As Quad)
    Local plate As DWord
    plate = HEAP_Alloc(%nodesize)
    Poke(Quad, plate, v)
    Poke(DWord, plate + %quadsize, stack)
    stack = plate
    End Function

    '-----------------------------------------------------------------------------------------------------------------------

    Function pop() As Quad
    Local v As Quad
    Local crackedplate As DWord
    crackedplate = stack
    v = Peek(Quad, stack)
    stack = Peek(DWord, stack + %quadsize)
    HEAP_Free(crackedplate)
    Return v
    End Function

    '-----------------------------------------------------------------------------------------------------------------------

    Function emptystack() As Byte
    If stack = 0 Then Return TRUE
    Return FALSE
    End Function

    '-----------------------------------------------------------------------------------------------------------------------
    [/code]
    Attached Files Attached Files
    "You can't cheat an honest man. Never give a sucker an even break, or smarten up a chump." - W.C.Fields

  2. #2

    Re: A Stack of Quads

    I love stacks and strings

    Here is a quad stack held inside a string. When you run out of stack space the string is automatically extended.


    [code=thinbasic]
    '==========================
    'QUAD STACK USING A STRING:
    '==========================

    Dim As String s 'STACK
    Dim As Long p=1 'STACK POINTER


    '------------------
    Sub push(q As Quad)
    '==================
    If p+8>Len(s) Then
    s+=String$(8000,Chr$(0))
    End If
    Mid$(s,p)=MKQ$(q)
    p+=8
    End Sub

    '---------------------
    Function pop() As Quad
    '=====================
    If p<9 Then
    MsgBox 0,"Stack empty!"
    Exit Function
    End If
    p-=8
    Function=CVQ(s, p)
    End Function


    push 1 : push 2 push 3

    MsgBox 0,"POPS"+$CRLF+pop+$CRLF+pop+$CRLF+pop

    pop 'ATTEMPT TO POP FROM AN EMPTY STACK
    [/code]

  3. #3
    thinBasic MVPs danbaron's Avatar
    Join Date
    Jan 2010
    Location
    California
    Posts
    1,378
    Rep Power
    152

    Re: A Stack of Quads

    [font=courier new]I like it.

    I learned a lot.

    Your way is shorter, and seems better.

    I put some comments in your code.


    Dan :P

    [code=thinbasic]'==========================
    'file = QStringStack.tbasic
    '==========================
    'QUAD STACK USING A STRING:
    '==========================

    'I didn't know you could do all this stuff with a string.

    Dim As String s 'STACK
    Dim As Long p = 1 'STACK POINTER
    Dim i As Byte

    '------------------
    Sub push(q As Quad)
    '==================
    If p + 8 > Len(s) Then
    'I didn't know you could do "s += " for strings.
    'You only have to allocate more string space, if the number of quads exceeds 999.
    'And, you never have to deallocate string space.
    'My way allocates for every "push", and deallocates for every "pop".
    s += String$(8000, Chr$(0))
    End If
    'I didn't know about MKQ$().
    Mid$(s, p) = MKQ$(q)
    p += 8
    End Sub

    '---------------------
    Function pop() As Quad
    '=====================

    'p = 1, 9, 17, ..
    If p = 1 Then
    MsgBox 0,"Stack empty!"
    Exit Function
    End If
    p -= 8
    'I didn't know about CVQ.
    'I always use "Return ". You use "Function = ".
    Function = CVQ(s, p)
    End Function

    'Do it twice, to make sure.
    For i = 1 To 2

    'Apparently, you don't need parentheses.
    push 1 : push 2 push 3
    'I always use Console_Writeline. You use MsgBox.
    'I didn't know about $CRLF.
    MsgBox 0,"POPS"+$CRLF+pop+$CRLF+pop+$CRLF+pop

    pop 'ATTEMPT TO POP FROM AN EMPTY STACK

    Next[/code]
    Attached Files Attached Files
    "You can't cheat an honest man. Never give a sucker an even break, or smarten up a chump." - W.C.Fields

  4. #4

    Re: A Stack of Quads


    If you don't need the flexibility of strings then the simplest way is to use an array. Redim Preserve allows the stack to be expanded.

    A script is often easier to read when unnecessary brackets are omitted, though sometimes you need to keep the brackets in to show that the symbol really is a function, not a simple variable.

    Charles

    [code=thinbasic]
    '==========================
    'QUAD STACK USING AN ARRAY:
    '==========================

    Dim As Quad s(1) 'STACK
    Dim As Long i=1 'STACK INDEX


    '------------------
    Sub push(q As Quad)
    '==================
    If i>UBound(s) Then
    ReDim Preserve s(i+100)
    End If
    s(i)=q
    Incr i
    End Sub

    '---------------------
    Function pop() As Quad
    '=====================
    If i<2 Then
    MsgBox 0,"Stack empty!"
    Exit Function
    End If
    Decr i
    Function=s(i)
    End Function


    push 1 : push 2 push 3

    MsgBox 0,"POPS"+$CRLF+pop+$CRLF+pop+$CRLF+pop

    pop 'ATTEMPT TO POP FROM AN EMPTY STACK
    [/code]

  5. #5
    thinBasic MVPs danbaron's Avatar
    Join Date
    Jan 2010
    Location
    California
    Posts
    1,378
    Rep Power
    152

    Re: A Stack of Quads

    [font=courier]Using Redim Preserve, is simply simple.

    It makes the code to implement a stack, look like nothing.

    And, I think you could use it for UDTs.


    Dan :P

    [code=thinbasic]'------------------------------------------------------------------
    'file = qstack2.tbasicc
    '------------------------------------------------------------------

    Uses "Console"

    %range = 2
    'Make %stackincrement small for this test, to make sure the allocation works correctly.
    %stackincrement = 8

    Global stack(1) As Quad
    Global sindex As DWord = 1

    '------------------------------------------------------------------

    Function TBMain()
    Local i, j As Quad

    For i = 1 To 10

    For j = -%range * i To %range * i
    push(j)
    Next

    For j = -%range * i To %range * i + 1
    If emptystack() Then
    Console_WriteLine("Stack empty.")
    else
    Console_WriteLine(pop())
    EndIf
    Next

    Next

    End Function

    '------------------------------------------------------------------

    Sub push(q As Quad)
    If sindex > UBound(stack) Then
    ReDim Preserve stack(sindex + %stackincrement)
    End If
    stack(sindex) = q
    Incr sindex
    End Sub

    '------------------------------------------------------------------

    Function pop() As Quad
    Decr sindex
    Return stack(sindex)
    End Function

    '------------------------------------------------------------------

    Function emptystack() As Byte
    If sindex = 1 Then Return TRUE
    Return FALSE
    End Function

    '------------------------------------------------------------------
    [/code]
    Attached Files Attached Files
    "You can't cheat an honest man. Never give a sucker an even break, or smarten up a chump." - W.C.Fields

Similar Threads

  1. triangles and quads
    By kryton9 in forum M15 file format
    Replies: 7
    Last Post: 19-12-2007, 14:10
  2. Cylinder from Quads
    By matthew in forum TBGL Scripts and Projects
    Replies: 6
    Last Post: 02-06-2007, 20:04

Members who have read this thread: 0

There are no members to list at the moment.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •