Tweet
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
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
Comment