Introduction to Object-Oriented Programming
using CA-Clipper 5
By Johann van der Walt - CEG

I must confess, until recently I had not used the object extensions available
for Clipper.  I did not see the need for them.  I was already as productive as
I could be with Clipper.  All the procedures and functions that I designed,
were done with re-usability in mind, and I have never written a system that
does not fit the Data-Driven paradigm. So why would I need to create my own
classes?  And to be quite frank, I thought that all those new terms, and the
new syntax surrounding this new idea were just there to confuse the issue.

Well, I was wrong!  - This is not a new way of programming.  This way of
programming has been around longer than most of us have been programmers!
Take the following definition:

An Object is a package of information and descriptions of its manipulation.

This definition was published in an article in BYTE magazine dated August
1981.  Yes, 1981, not 1991!  And that was not the start of object oriented
programming.  It started back in 1967! It started with a language called
Smalltalk.  Smalltalk was based on a language called SIMULA, which introduced
the concepts of objects, messages and classes.  The language Simula 67, an
extension of ALGOL 60, was designed in 1967 by Ole-Johan Dahl and Krysten
Nygaard from the university of Oslo and the Norwegian Computing Centre.  It
allowed users to create object-oriented systems, but used the standard
data/procedure-oriented ALGOL language to provide numbers, booleans, basic
data structures and control structures.

Smalltalk was the brain child of Alan Kay.  It grew out of his vision of
Dynabook, a powerful computer about the size of a notebook that would only
cost a few hundred dollars (and that was in 1972!).  The Dynabook was designed
for use by children but would be a sophisticated computer with large storage
capacity, a flat touch-sensitive, bit-mapped graphics display, audio output,
and communications capabilities.  Smalltalk was to provide the software
environment for the Dynabook project.

Object-oriented programming is different.  There is a total change in mind
set.  But dont get scared off, you will still need your old programming
skills!.  Lets first look at the difference between object- oriented
programming and conventional programming.  It  can be seen in the evaluation
of the following simple expression:

1 + 5

In conventional programming terms:

The addition operator is applied to the two integer operands 1 and 5,
returning the result 6.

In object-oriented terms:

The message + with the argument 5 is being sent to the integer object 1.
Integer objects know how to respond to this message and the integer object 6
is returned as the result.

Notice the change in emphasis.  It is the integer object 1 which determines
how the expression is evaluated, whereas, in the procedural approach it is the
addition operator which is in control.

But this is enough about the theory of object-oriented programming.  According
to me, object-oriented programming is just a nice formal way of helping us to
write better re-usable code.  When building a house, you do not want to first
make the bricks yourself.  No, it is much easier and more productive to get an
expert to make the bricks for you.  This is exactly what object-oriented
programming will do for your future projects - let you use all the building
blocks available, and even let you create new ones using existing ones.

In this talk, I want to show you how easy it is to create your own classes,
and that you can gain a lot in productivity from creating your own classes.

TBROWSE and OODLES

For the purpose of this talk, I will use TBROWSE as the sample class and show
you how new TBROWSE classes can enhance your current and future programming.
The reason for choosing TBROWSE is the fact that TBROWSE is most of the time
your first experience with Clippers build- in classes.  So some of it will
already be familiar to you.  I am also going to use OODLES as the way of
creating my own classes, because it is the simplest (and cheapest) way of
adding class creation capabilities to CA-Clipper.

But OODLES does not allow me to Inherit from CA-Clippers built-in Classes!
Although this originally looked like a big stumbling block, it was actually
very easy to overcome.  The only real problem that I found, was that it was
not documented in the OODLES manual.  I found this information as well as the
way of implementing it in the (supplied!) source code for Browse Manager.

Container Classes
This limitation brings us to a Container Class.  A container Class is a Class
containing other objects.  We can not inherit from Tbrowse, but we can inherit
form our own classes, even if that class contains a Tbrowse object.  So all we
need to do is to create a new browse class that contains an instance variable
for our Tbrowse object and also a method for each method in the standard
browse.

Example:

Class Basebrowse
    Var oBrowse
    Message Up  Action {|oB| oB:oBrowse:Up()}
    ....
    ....
End Class

This will take care of all the messages.  But what about the instance
variables?  If you look closely at to source code of Browse Manager you will
find a Container Class for Tbrowse.  This Container Class contains a set of
messages that looks very familiar.  For each instance variable there is a
message with the same name, as well as a message with the same name but it
starts with an underscore.  For example, the FREEZE instance variable has the
following declarations in the Browse Manager Container Class.

Message Freeze   Action{|oB|oB:oBrowse:Freeze()}
Message _Freeze  Action{|oB,_1|oB:oBrowse:_Freeze(_1)}

By debugging the code I worked out that the _Freeze Message is the Assignment
message and the Freeze Message without the underscore is the Retrieval
message.  This is very powerful!  This actually means that every instance
variable has its own assignment and retrieval message.  Well, according to
OOPs documentation, it is suppose to be like this.  In true object-oriented
languages, every thing is suppose to be an object, and every manipulation
takes place through messages that are sent to the object.  No only will this
help us to create a better container class, but it will also allow us to do
validation on assignments and retrieval of instance variables.  Can you
imagine the power of this?

The source code for our BaseBrowse Class can be found in the Members Area of
the BBS.  The file name is BaseBrow.ZIP.

Inheritance
Now that we have a BaseBrowse, we can start enhancing this standard browse.
One of the first things that I would like to add to the standard Tbrowse is a
default key handler method.  To accomplish this, we need to create a new
class, lets call it the BrowseKeys Class.  But we do not need to start from
scratch again, by using the capability of inheriting all the functionality
from our baseclass, we only need to define the new method.

#Include "oops.ch"
#Include "Inkey.ch"

Class BrowseKeys Inherit BaseBrowse
  Message DefaultKey(nKey)
End Class



Method DefaultKey(nKey)
  Local lHandled := .F.
  Do Case
   Case nKey == K_DOWN
	::down()		;lHandled:=.T.
   Case nKey == K_END
	::end()		;lHandled:=.T.
   Case nKey == K_CTRL_PGDN
	::goBottom()	;lHandled:=.T.
   Case nKey == K_CTRL_PGUP
	::goTop()		;lHandled:=.T.
   Case nKey == K_HOME
	::home()		;lHandled:=.T.
   Case nKey == K_LEFT
	::left()		;lHandled:=.T.
   Case nKey == K_PGDN
	::pageDown()	;lHandled:=.T.
   Case nKey == K_PGUP
	::pageUp()	;lHandled:=.T.
   Case nKey == K_CTRL_END
	::panEnd()	;lHandled:=.T.
   Case nKey == K_CTRL_HOME
	::panHome()	;lHandled:=.T.
   Case nKey == K_CTRL_LEFT
	::panLeft()	;lHandled:=.T.
   Case nKey == K_CTRL_RIGHT;
	::panRight();	lHandled:=.T.
    Case nKey == K_RIGHT
	::right()		;lHandled:=.T.
    Case nKey == K_UP
	::up()		;lHandled:=.T.
  EndCase
Return lHandled

// end of class definition

In the implementation of the method Defaultkey, you can see that there is
nothing special about a method - we receive some parameters, declares some
local variables and return a value.  The syntax is exactly the same as that of
a Function.  Actually, OODLES makes use of the Pre-Processor to define Methods
as Static Functions.

Overloading of Methods

The term overloading is used when a newly created class re-defines some of the
methods of the superclass from which it inherits its basic definition.  To
illustrate this concept, I want to create a new class, the BoxClass, which
includes automatic screen saving and box drawing capabilities.  This new class
adds two new instance variables, BrowseArea and BoxType, as well as two new
messages, Display() and Kill().  But the original NewDB() and NEW() methods
needs to be replace with a new version.  Note the message ::Super():NewDB() to
handle the normal initialisation.

#Include "oops.ch"
#Include "Box.ch"
#Include "Common.ch"

Class BrowseBox Inherit BrowseKeys
  Var BrowseArea                  // the savescreen var
  Var BoxType                     // What type of box
  Message NewDB(t,l,b,r,nLineType)// Overload cstr
  Message New(t,l,b,r,nLineType)  // Overload cstr
  Message Display()               // Display the Box
  Message Kill()                  // Hide the TBrowse
  Message Configure()             // Overload
..................................// configure
End Class

Method NewDB(t,l,b,r,nLineType)
  ::Super():NewDB(t+1,l+1,b-1,r-1)
  Default nLineType To 1
  ::BrowseArea := SaveScreen(t,l,b,r)
  ::BoxType := nLineType
  Do Case
    Case nLineType == 1
      ::HeadSep := Chr(194)
      ::ColSep  := Chr(179)
      ::FootSep := Chr(193)
    Case nLineType == 2
      ::HeadSep := Chr(209)
      ::ColSep  := Chr(179)
      ::FootSep := Chr(207)
  EndCase
Return (Self)

Method New(t,l,b,r,nLineType)
  ::Super():New(t+1,l+1,b-1,r-1)
  Default nLineType To 1
  ::BrowseArea := SaveScreen(t,l,b,r)
  ::BoxType := nLineType
  Do Case
    Case nLineType == 1
      ::HeadSep := Chr(194)
      ::ColSep  := Chr(179)
      ::FootSep := Chr(193)
    Case nLineType == 2
      ::HeadSep := Chr(209)
      ::ColSep  := Chr(179)
      ::FootSep := Chr(207)
  EndCase
Return (Self)



Method Display()
  Do Case
    Case ::BoxType == 1
      DispBox(::nTop-1,::nLeft-1, ;
              ::nBottom+1,::nRight+1,;
              B_DOUBLE,::ColorSpec)
    Case ::BoxType == 2
      DispBox(::nTop-1,::nLeft-1,;
              ::nBottom+1,::nRight+1,;
              B_SINGLE,::ColorSpec)
  End Case
Return Self


Method Configure()
  Do Case
    Case ::BoxType == 1
      DispBox(::nTop-1,::nLeft-1,;
              ::nBottom+1,::nRight+1,;
              B_DOUBLE,::ColorSpec)
    Case ::BoxType == 2
      DispBox(::nTop-1,::nLeft-1,;
              ::nBottom+1,::nRight+1,;
              B_SINGLE,::ColorSpec)
  End Case
  ::Super():Configure()
Return Self

Method Kill()
  RestScreen(::nTop-1,::nLeft-1,;
             ::nBottom+1,::nRight+1,;
             ::BrowseArea)
Return (Self)

// end of class definition

Modular Programming
So what do we gain by using object-oriented techniques in our code.  I think
we must look at object- oriented programming as the ultimate in re-usability
and true modular programming.  A newly defined class definitely contains all
its manipulation in the definition itself.  The Class definition - the
instance variables and the messages - defines the interface to this new
module.  And we do have full control over the usage of our class definition -
even the assignment of values to instance variables is under our control.

The last example that I want to show is a new class called the BrowseLite
Class.  This class adds the capability of having a hilite bar over the full
browse window and not only the traditional column hilite. Previously I used
the ColorRect capabilities of the standard Tbrowse to display a hilite bar
over multiple columns.  Although this works, the hilite bar is actually a
broken line which only hilites the data itself.  With my new BrowseLite Class,
the Hilite bar will be a continuous line that hilites not only the data, but
rather the full line.  The problem with this was that in a
runtime-configurable browse, I allow the user to change the color of the
browse by assigning a new value to the ColorSpec instance variable.  But a
change in the contents of the ColorSpec instance variable may mean a change in
the color of the Hilite bar.  Therefore I needed to modify the behaviour of
the ColorSpec Assignment Method to notify the browse that the color of the
hilite bar must change.

#Include "oops.ch"
#Include "Box.ch"
#Include "Common.ch"

Static aColors := ;
{{"N",0},{"B",1},{"G",2},{"BG",3},{"R",4},;
                 {"RB",5},{"GR",6},{"W",7},{"N+",8},;
                 {"B+",9},{"G+",10},{"BG+",11},;
                 {"R+",12},{"RB+",13},{"GR+",14},;
                 {"W+",15}}


Class BrowseLite Inherit BrowseBox
  Var HiliteLine   // Hiliteline of normal
                   // hilite field
  Var HiliteAttr   // The Hilite attribute Number
  Var NormAttr     // The Normal attribute Number

  Message Hilite()              // overload Hilite
  Message DeHilite()            // overload DeHilite
  Message ForceStable()         // overload
                                // ForceStable
  Message Stabilize()           // overload Stabilize
  Message NewDB(t,l,b,r,nLineType) // overload
                                   //constructor
  Message New(t,l,b,r,nLineType)   // overload
                                   // constructor
  Message _COLORSPEC    ;          // overload
                        ;          //assignment
     Action { |oB,_1| ;            // reset inst vars
          ob:HiliteAttr := oB:NormAttr := NIL,;
          oB:oBrowse:_COLORSPEC(_1)   }

End Class

Method NewDB(t,l,b,r,nLineType)
  ::Super():NewDB(t+1,l+1,b-1,r-1)
  ::HiliteLine := .T.  // default want a hilite line
Return (Self)

Method New(t,l,b,r,nLineType)
  ::Super():New(t+1,l+1,b-1,r-1)
  ::HiliteLine := .T.  // default want a hilite line
Return (Self)

Method ForceStable()
  Local IsAutolite := ::AutoLite
  If ::HiliteLine
    If IsAutoLite
      ::DeHilite()
      ::Autolite := .f.
    Endif
    ::Super():ForceStable()
    If IsAutoLite
      ::Autolite := .t.
      ::Hilite()
    Endif
  Else
    ::Super():ForceStable()
  Endif
Return (Self)

Method Stabilize()
  Local IsAutolite := ::AutoLite
  Local lReturn
  If ::HiliteLine
    If IsAutolite
      ::DeHilite()
      ::Autolite := .f.
    Endif
    lReturn := ::Super():Stabilize()
    If IsAutoLite
      ::Autolite := .t.
      ::Hilite()
    Endif
  Else
    lReturn := ::Super():Stabilize()
  Endif
Return (lReturn)

Method Hilite()
 Local cColor,cFor,cBack
 Local nStart,nEnd,nFor,nBack

 If ::HiliteLine
   If ::HiliteAttr == NIL
     nStart := At(",",::ColorSpec)+1
     nEnd   := At(",",Substr(::Colorspec,nStart))-1
     If nEnd < 1
       nEnd := Len(::ColorSpec)
     Endif
     cColor := Substr(::ColorSpec,nStart,nEnd)
     cFor   := Substr(cColor,1,At("/",cColor)-1)
     cBack  := Substr(cColor,(At("/",cColor)+1))
     nFor   := Ascan(aColors,{|a|a[1] == cFor })
     nBack  := Ascan(aColors,{|a|a[1] == cBack })
     ::HiliteAttr := aColors[nFor,2] + ;
                      aColors[nBack,2] * 16
   Endif
  RestScreen( Row(),::nLeft,Row(),::nRight,;
  Transform( SaveScreen(Row(),::nLeft,;
				Row(),::nRight),;
  Replicate("X"+chr(::HiliteAttr),;
				::nRight-::nLeft+1)))
 Else
   ::Super():Hilite()
 Endif

Return (Self)

Method DeHilite()
  Local cColor,cFor,cBack
  Local nStart,nEnd,nFor,nBack

  If ::HiliteLine
    If ::NormAttr == NIL
      nStart := 1
      nEnd := At(",",::ColorSpec)-1
      cColor := Substr(::ColorSpec,nStart,nEnd)
      cFor   := Substr(cColor,1,At("/",cColor)-1)
      cBack  := Substr(cColor,(At("/",cColor)+1))
      nFor   := Ascan(aColors,{|a|a[1] == cFor })
      nBack  := Ascan(aColors,{|a|a[1] == cBack })
      ::NormAttr := aColors[nFor,2] + ;
                    aColors[nBack,2] * 16
    Endif
    RestScreen( Row(),::nLeft,Row(),::nRight,;
    Transform( SaveScreen(Row(),::nLeft,;
                          Row(),::nRight),;
    replicate("X"+chr(::NormAttr),;
				::nRight-::nLeft+1)))
  Else
    ::Super():DeHilite()
  Endif
Return Self

// end of class definition

