Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Objects, Inheritence and Linked-Lists

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Chris Holbrook
    replied
    Nice clear example, thanks!

    Leave a comment:


  • Mark Smit
    started a topic Objects, Inheritence and Linked-Lists

    Objects, Inheritence and Linked-Lists

    Hi Guys,

    I know most of you already know all this but I thought posting this might help others. The code below demonstrates the following...

    1. Interface Inheritance
    2. Implementation Inheritance
    3. Singly Linked-List


    Code:
    '==============================================================================
    ' This code demonstrates the following
    ' 1. Interface Inheritance
    ' 2. Implementation Inheritance
    ' 3. Linked-List
    '==============================================================================
    #COMPILER PBCC
    #COMPILE EXE
    #DIM ALL
    
    
    
    '==============================================================================
    ' Constants
    '------------------------------------------------------------------------------
    %FALSE  = 0
    %TRUE   = NOT %FALSE
    
    
    
    '==============================================================================
    ' Base Animal Class
    '------------------------------------------------------------------------------
    CLASS CBaseAnimal
        INSTANCE m_szName   AS STRING
        INSTANCE m_qID      AS QUAD
        INSTANCE m_Animal   AS IAnimal
    
    
        INTERFACE IBaseAnimal
            INHERIT IUNKNOWN
    
            '----------------------------------------------------------------------
            ' Get table ID
            '----------------------------------------------------------------------
            PROPERTY GET ID() AS QUAD
                PROPERTY = m_qID
            END PROPERTY
    
            '----------------------------------------------------------------------
            ' Set table ID
            '----------------------------------------------------------------------
            PROPERTY SET ID(BYVAL qID AS QUAD)
                m_qID = qID
            END PROPERTY
    
            '----------------------------------------------------------------------
            ' Get table name
            '----------------------------------------------------------------------
            PROPERTY GET NAME() AS STRING
                PROPERTY = m_szName
            END PROPERTY
    
            '----------------------------------------------------------------------
            ' Set table name
            '----------------------------------------------------------------------
            PROPERTY SET NAME(BYVAL szName AS STRING)
                m_szName = szName
            END PROPERTY
    
            '----------------------------------------------------------------------
            ' Get next animal
            '----------------------------------------------------------------------
            PROPERTY GET NEXT() AS IAnimal
                PROPERTY = m_Animal
            END PROPERTY
    
            '----------------------------------------------------------------------
            ' Set next animal
            '----------------------------------------------------------------------
            PROPERTY SET NEXT(BYVAL Animal AS IAnimal)
                m_Animal = Animal
            END PROPERTY
    
            '----------------------------------------------------------------------
            ' Get end of list status
            '----------------------------------------------------------------------
            PROPERTY GET END() AS LONG
                PROPERTY = ISNOTHING(m_Animal)
            END PROPERTY
        END INTERFACE
    END CLASS
    
    
    
    '==============================================================================
    ' Cat Class
    '------------------------------------------------------------------------------
    CLASS CCat
        CLASS METHOD CREATE()
            COLOR 10:STDOUT"CCat:Create";
            COLOR 7:STDOUT
        END METHOD
    
        CLASS METHOD destroy()
            COLOR 12:STDOUT"CCat:Destroy";
            COLOR 7:STDOUT
        END METHOD
    
        INTERFACE IAnimal
            INHERIT CBaseAnimal, IBaseAnimal
    
            PROPERTY GET TYPE() AS STRING
                PROPERTY = "Cat"
            END PROPERTY
        END INTERFACE
    END CLASS
    
    
    
    '==============================================================================
    ' Dog Class
    '------------------------------------------------------------------------------
    CLASS CDog
        CLASS METHOD CREATE()
            COLOR 10:STDOUT"CDog:Create";
            COLOR 7:STDOUT
        END METHOD
    
        CLASS METHOD destroy()
            COLOR 12:STDOUT"CDog:Destroy";
            COLOR 7:STDOUT
        END METHOD
    
    
        INTERFACE IAnimal
            INHERIT CBaseAnimal, IBaseAnimal
    
            PROPERTY GET TYPE() AS STRING
                PROPERTY = "Dog"
            END PROPERTY
        END INTERFACE
    END CLASS
    
    
    
    '==============================================================================
    ' Dolphin Class
    '------------------------------------------------------------------------------
    CLASS CDolphin
        CLASS METHOD CREATE()
            COLOR 10:STDOUT"CDolphin:Create";
            COLOR 7:STDOUT
        END METHOD
    
        CLASS METHOD destroy()
            COLOR 12:STDOUT"CDolphin:Destroy";
            COLOR 7:STDOUT
        END METHOD
    
    
        INTERFACE IAnimal
            INHERIT CBaseAnimal, IBaseAnimal
    
            PROPERTY GET TYPE() AS STRING
                PROPERTY = "Dolphin"
            END PROPERTY
        END INTERFACE
    END CLASS
    
    
    
    '==============================================================================
    ' Zoo Class
    '------------------------------------------------------------------------------
    CLASS CZoo
        INSTANCE m_Animal AS IAnimal
    
        INTERFACE IZoo
            INHERIT IUNKNOWN
    
            '----------------------------------------------------------------------
            ' Add animal to zoo
            '----------------------------------------------------------------------
            METHOD Add(NewAnimal AS IAnimal) AS LONG
                DIM CurAnimal   AS IAnimal
    
    
                'Check new animal object
                IF ISNOTHING(NewAnimal) THEN
                    METHOD = %FALSE
                    EXIT METHOD
                END IF
    
                'Check root animal
                IF ISNOTHING(m_Animal) THEN
                    m_Animal = NewAnimal
                    METHOD = %TRUE
                    EXIT METHOD
                END IF
    
                'Tranverse animals
                CurAnimal = m_Animal
                WHILE ISOBJECT(CurAnimal)
    
                    'Check animal name
                    IF (CurAnimal.Name = NewAnimal.Name) THEN
                        METHOD = %FALSE
                        EXIT METHOD
                    END IF
    
                    'Found last animal
                    IF (CurAnimal.End) THEN
                        CurAnimal.Next = NewAnimal
                        METHOD = %TRUE
                        EXIT METHOD
                    END IF
    
                    'Goto next animal
                    CurAnimal = CurAnimal.Next
                WEND
    
                'Should never happen
                METHOD = %FALSE
            END METHOD
    
    
            '----------------------------------------------------------------------
            ' Remove animal from Zoo
            '----------------------------------------------------------------------
            METHOD Remove(BYVAL szName AS STRING) AS LONG
                DIM PrevAnimal  AS IAnimal
                DIM NextAnimal  AS IAnimal
    
                'Check root animal object
                IF ISNOTHING(m_Animal) THEN
                    METHOD = %FALSE
                    EXIT METHOD
                END IF
    
                'Check root animal name
                IF (m_Animal.Name = szName) THEN
                    m_Animal = m_Animal.Next
                    METHOD = %TRUE
                    EXIT METHOD
                END IF
    
                'Setup animal references
                PrevAnimal = m_Animal
                NextAnimal = m_Animal.Next
    
                'Traverse animals
                WHILE ISOBJECT(NextAnimal)
    
                    'Check next animal name
                    IF (NextAnimal.Name = szName) THEN
                        NextAnimal = NextAnimal.Next
                        PrevAnimal.Next = NextAnimal
                        METHOD = %TRUE
                        EXIT METHOD
                    END IF
    
                    'Goto next animal
                    PrevAnimal = NextAnimal
                    NextAnimal = NextAnimal.Next
                WEND
    
                'Animal not found
                METHOD = %FALSE
            END METHOD
    
    
            '----------------------------------------------------------------------
            ' Remove all animals from the Zoo
            '----------------------------------------------------------------------
            METHOD EMPTY()
                m_Animal = NOTHING
            END METHOD
    
    
            '----------------------------------------------------------------------
            ' Show list of animals
            '----------------------------------------------------------------------
            METHOD show()
                DIM Animal AS IAnimal
    
                'Show Zoo header
                STDOUT"Welcome to the Zoo"
                STDOUT"------------------"
    
                'Check root animal object
                IF ISNOTHING(m_Animal) THEN
                    COLOR 8:STDOUT"No animals to see";
                    COLOR 7:STDOUT
                END IF
    
                'Traverse animals
                Animal = m_Animal
                WHILE ISOBJECT(Animal)
                    COLOR 9:STDOUT USING$("& named &", Animal.Type, Animal.Name);
                    COLOR 7:STDOUT
                    Animal = Animal.Next
                WEND
    
                STDOUT
            END METHOD
        END INTERFACE
    END CLASS
    
    
    
    '==============================================================================
    ' Application entry point
    '------------------------------------------------------------------------------
    FUNCTION PBMAIN() AS LONG
        DIM Zoo     AS IZoo
        DIM Animal  AS IAnimal
    
    
        'Create zoo object
        Zoo = CLASS "CZoo"
        IF ISNOTHING(Zoo) THEN
            STDOUT"The Zoo is closed"
            GOTO Done
        END IF
    
    
        'Add Cat
        Animal = CLASS "CCat"
        IF ISOBJECT(Animal) THEN
            Animal.Name = "Dittens"
            Zoo.Add(Animal)
            Animal = NOTHING
        END IF
    
        'Add Dog
        Animal = CLASS "CDog"
        IF ISOBJECT(Animal) THEN
            Animal.Name = "Rex"
            Zoo.Add(Animal)
            Animal = NOTHING
        END IF
    
        'Add Dolphin
        Animal = CLASS "CDolphin"
        IF ISOBJECT(Animal) THEN
            Animal.Name = "Kipper"
            Zoo.Add(Animal)
            Animal = NOTHING
        END IF
    
    
        'Show animals
        Zoo.Show()
    
        'Remove 'Dittens'
        Zoo.Remove("Dittens")
        Zoo.Show()
    
        'Empty zoo
        Zoo.Empty()
        Zoo.Show()
    
    Done:
        STDOUT"Press ANY key to continue."
        WAITKEY$
    END FUNCTION
Working...
X