Facade Pattern (OOP)

Facade Pattern use classes from libraries and place them as inner objects (groups in M2000), and provide a simplify interface (here a doSomething method). Inside this method we can call some of the inner objects public members.

\\ Facade Pattern
Function Package1 {
      Class Class1 {
            module operationA {
                  Print "Class1 operationA"
            }
      }
      Class Class2 {
      Private:
            x=10
      Public:
            module operationB {
                  Print "Class2 operationB", .x
            }
      Class:
            module Class2(.x) {
            }
      }
      Class Class3 {
            Group Inner1 {
            Private:
                  z=2000
            Public:
                  x=100
                  module operationD {
                        Print "Class3 inner1 operationD", .z, .x
                  }
            }
            module operationC {
                  \\ we can't read the .inner1.z because .z is private to .Inner1
                  Print "Class3 operationC", .inner1.x, valid(.inner1.z)=false
            }      
      }
      Class Facade {
      Private:
            \\ these are private inner clases
            \\ not pointer to objects.
            Class1 a
            Class2 b(300)
            Class3 c
      Public:
            module doSomething {
                  .a.OperationA
                  .b.OperationB
                  .c.OperationC
                  .c.inner1.OperationD
            }
      }
      =Facade()
}
M=Package1()
Print M is type Facade
M.doSomething

State Pattern (OOP)

The state pattern change behaviour of StateContext, changing the internal state pointer to a state type object, depending on state. Here the writeName  return Nill or a State pointer and we check this and if it is a state object we change it.

class State {
      Function writeName (name$) {
            Error "Abstract"
      }
}

class LowerCaseState as State {
      Function writeName (name$) {
            Print Lcase$(name$)
            =pointer(MultipleUpperCaseState())
      }
}

class MultipleUpperCaseState as State {
Private:
      count = 0
Public:      
      Function writeName (name$) {
            Print Ucase$(name$)
            .count++
            if .count=2 Then
                  =Pointer(LowerCaseState())
                  .count<=0
            else
                  =Pointer()
            End if
      }
}

class StateContext {
private:      
      state=pointer()
public:
      module writeName(name$) {
            what=.state=>writeName(name$)
            if what is type state then .state<=what
             }
class:
      module StateContext {
            .state->LowerCaseState()
      }
}
Module StateDemo {
      context=StateContext()
      context.writeName "Monday"
      context.writeName "Tuesday"
      context.writeName "Wednesday"
      context.writeName "Thursday"
      context.writeName "Friday"
      context.writeName "Saturday"
      context.writeName "Sunday"
}
StateDemo

Proxy Pattern (OOP)

The proxy pattern has a Proxy class which inherits from a Subject class and a reference of a RealSubject, which also inherits from Subject class. We can use the proxy as the RealSubject. Here we have a proxy for a picture from a file. We want first to put the name to object. We want to see that name and maybe we want to load and draw the picture to screen. The RealSubject has a function to load the picture and return true if the picture loaded. Also mark the state so when we decide to draw check the state and do the drawing. The proxy combine the load and draw in the draw operation. We can use the proxy as a RealSubject, because has the same interface, but the methodC has advance logic, and can be used as for RealSubject if first we use methodB() or as the proxy using methodC which handle the state and can decide to call methodB() on the RealSubject which hold a pointer to any class support Subject interface. (M2000 hasn't interfaces, but we mimic that using classes with erroneous methods, which raise error "Abstract" or anything else)

\\ Proxy Pattern

class Subject {
private:      
      filename$, loadpicture
Public:
      module methodA {
            error "Abstact"
      }
      function methodB {
            error "Abstact"
      }
      module methodC {
            error "Abstact"            
      }      
}
class Proxy as Subject {
      RealSubject=pointer()
      module methodA {
            .RealSubject=>methodA
      }
      function methodB {
            if not .loadpicture then .loadpicture<=.RealSubject=>methodB()
            =.loadpicture
      }
      module methodC {
            if not .loadpicture then
                  .loadpicture<=.RealSubject=>methodB()
            end if
            .RealSubject=>methodC
      }            
class:
      module Proxy (p as *Subject) {
            .RealSubject<=p
      }
}
class RealSubject as Subject {
      module methodA {
            Print "The name of a file of a picture:"; .filename$
      }
      function methodB {
            .loadpicture<=true
            Print "Load the picture"
            =.loadpicture
      }
      module methodC {
            if .loadpicture then
                  Print "Draw the picture"
            End if
      }
class:
      module RealSubject (.filename$) {
      }
}
M=RealSubject("alfa.bmp")
M.methodA
if M.methodB() then M.methodC
\\ Now we make the proxy
K=Proxy(Pointer(RealSubject("beta.bmp")))
K.methodA
\\ proxy may call an operation methodB before actually call the methodC
K.methodC
K.methodC

Flyweight Pattern (OOP)

The Flyweight Pattern used when a client object has two parts, one which have intrinsic state, and another which is extrinsic. Here soldier has intrinsic the graphical representation, but the position handled as extrinsic, from the SoldierClient, which hold the current X and Y values.

This statement Dim warSoldier(1 to 5)<<SoldierClient() make an array and execute the SoldierClient for each item on the array. A SoldierClient make an internal Soldier from Soldierfactory. Soldierfactory isn't a class, is an object and we make it as global (so we can use it from Class). The SoldierFactory keep a pointer to a SoldierImp, and return that pointer We can change that to return object as a copy of the pointed group using Group(.Solider) and then we use .Soldier.moveSoldier .currX, .currY, toX, toY and notice that we use a dot and not fat arrow => as for .Soldier as pointer to Group. Because we want extrinsic state to handled by SoldierClient we keep the first option, the use of pointer in SoldierFactory in method getSoldier().

We apply two set of coordinates for 5 warSoldiers. Notice the use of -1000 as an out of area position. So when we have to draw we check if the soldier is hidden by checking the -1000 value.  The same hold when we have to remove the soldier, the value -1000 tell that it was hidden, so skip the removing.

\\ Flyweight Pattern
class Soldier {
      module moveSoldier {
            error "abstract"
      }
}
Global Group GraphicalSoldierRepresentation {
      \\ render the representation of a soldier
      \\ it is the same for each soldier
      module drawSoldier (X, Y){
            Print "Soldier draw to ", X, Y
      }
      module removeSoldier (X, Y) {
            Print "Soldier removed from ", X, Y
      }
}
class SoldierImp as Soldier {
      \\ we put only a reference to the global group
private:
      GraphicalRepresentation=Pointer(GraphicalSoldierRepresentation)
Public:
      module moveSoldier(fromX, fromY, toX, toY) {
            \\ delete soldier representation from previous location
            \\ then render soldier representation in new location
            if fromY>-1000 then .GraphicalRepresentation=>removeSoldier fromX, fromY
            if toY>-1000 then .GraphicalRepresentation=>drawSoldier toX, toY
            
      }
}
Global Group SoldierFactory {
Private:
      soldier=Pointer()
Public:
      Function GetSoldier {
            if .soldier is type null then .soldier<=Pointer(SoldierImp())
            \\ return object as copy the one which soldier points
            =.soldier
      }
}
class SoldierClient {
Private:
      Soldier=SoldierFactory.GetSoldier()
      currX=-1000, currY=-1000
Public:
      module moveSoldier(toX, toY) {
            .Soldier=>moveSoldier .currX, .currY, toX, toY
            \\ multiassign. Notice that we didn't use <=
            \\ this happen because actually interpreter
            \\ push values to stack and read to the variables on the left
            (.currX, .currY)=(toX, toY)
      }
}
Flush ' empty the stack
Dim warSoldier(1 to 5)<<SoldierClient()
Data 100,200, 400,500,700,300,150,200, 30,160
For i=1 to 5
For warSoldier(i) {
      \\ we can remove Read statement, and posX, posY in .moveSoldier
      \\ because the stack of values is the same for modules
      Read posX, posY
      .moveSoldier posX, posY
}
Next
\\ new positions
Data 110,200, 440,500,700,350,150,-1000, 30,-1000
For i=1 to 5
For warSoldier(i) {
      .moveSoldier
}
Next
Print "Done"

Decorator Pattern (OOP)

M2000 is an interpreter, so make objects at runtime always. Here the decorator pattern used to add functionality (and type)  in a Circle type object (a group in M2000). So we don't extend the class Circle, but an object. We can merge two or more objects to be one object and the we make a new one from that. See this: Cir3=Circle(100) with ColorCircle(10)  we make a Circle of radius 100 and add a ColorCircle of pen color 10. The final object create the Cir3. Cir3 is a named group not a pointer to group. We can use Cir3 -> (Circle(100) with ColorCircle(10)) to make it a pointer to combined objects. Parenthesis needed because -> read one identifier or something in parenthesis. The same hold for pointer() which do the same (is identical with ->, but used where we can't use thin arrow ->)

We can make a Group without Type and we can add functionality without adding a type to final object. We can check if a named group has a specific method (module or function), using module() function. In the short example we didn't add a type, because Group aDecoration is typeless We can add types in a group putting a line Type: MyType1, MyType2

\\ Decoration Pattern (short example)
Class Anything {
Private:
      myvalue=100
Public:
      module DoSomething {
            Print "something"
      }
}
Group aDecoration {
      module DoSomething {
            Print "something change"
      }
      module DoSomethingElse (p as Anything){
            \\ we can read private myvalue from p
            \\ when this group is merged with a type Anything class
            Print "Do something Else", .myvalue+p.myvalue
      }
}
One=Anything() with aDecoration
One.DoSomethingElse Anything()
Two=Anything()
Two.DoSomething
Print module(Two.DoSomethingElse)=False
\\ adding later
Two=aDecoration
Two.DoSomething
Print module(Two.DoSomethingElse)=True

This is the Circle Example

\\ Decorator Pattern

Class Circle {
Private:
      radius
Public:
      module render (X, Y) {
            Print Format$("Draw a circle at {0},{1} of radius {2} using standard pen", X, Y, .radius)
      }
Class:
      module Circle (.radius) {
      }
}
Class ColorCircle {
Private:
      circlepen=0
Public:
      module render (X, Y) {
            Print Format$("Draw a circle at {0},{1} of radius {2} using pen {3}", X, Y, .radius,.circlepen)
      }
Class:
      module ColorCircle (.circlepen) {
      }      
}
Cir1=Circle(500)
Cir1.render 500, 400
\\ inheritance at object level composing two or more objects at right expression
Cir2=Cir1 with ColorCircle(15)
Cir2.render 120, 300
\\ inheritance at object level by merging to object.
Cir1=ColorCircle(13)
Cir1.render 500, 400
Cir3=Circle(100) with ColorCircle(10)
Cir3.render 200, 200

Composite Pattern (OOP)

The composite pattern works for structures (trees) where we have two kinds, the leaf and the composite. The composite perform an operation to all children's , If child is a leaf perform an operation for leaf, if it is a composite perform an operation for all children's on that composite.

Simple:

\\ Composite Pattern

Class iComponet {
      module operation {
            error "Abstract"
      }
}
Class Componet as iComponet {
Private:
      name$
Public:
      module operation {
            print "do something"
      }
      remove {
            Print "remove ";.name$
      }
}
Class Leaf as Componet {
      module operation {
            Print "do an operation to this leaf:";.name$
      }
Class:
      module Leaf (.name$) {
      }
}
Class Composite as Componet {
      m=stack
      module operation {
       k=each(.m)
       Print "["+.name$+"]"
       while k
             z=stackitem(k)
             z=>operation
       end while
      }
      module addChild (child as *Componet) {
            stack .m {data child}
      }
Class:
      module Composite (.name$) {
      }
}
M->Composite("GroupA")
M=>addChild pointer(Leaf("Shape1"))
M=>addChild pointer(Leaf("Shape2"))
M=>addChild pointer(Leaf("Shape3"))
M1->Composite("Graphic")
M1=>addChild M
M->Composite("GroupB")
M=>addChild pointer(Leaf("Shape4"))
M1=>addChild M
M->0&
M1=>operation

Advanced (has a deep copy function for components) :

If we add a Push MM as last statement in Module A then the groups form MM (one composite with one leaf) pushed to current stack. So the last 2 lines "remove.." not displayed. The current stack is the same as the stack in console level (or level 0). So if we write flush we get the 2 remove (from the 2 objects). 

\\ Composite Pattern

Class iComponet {
      module operation {
            error "Abstract"
      }
}
Class Componet as iComponet {
Private:
      name$
Public:
      module operation {
            print "do something"
      }
      function Copy {
            C=This
            ->(C)
      }
      remove {
            Print "remove ";.name$
      }
}
Class Leaf as Componet {
      totalOperations=0
      module final operation {
            .totalOperations++
            Print "do an operation to this leaf:";.name$, .totalOperations
      }
Class:
      module Leaf (.name$) {
      }
}
Class Composite as Componet {
Private:
      m=stack
Public:
      totalOperations=0
      module final operation {
            k=each(.m)
            .totalOperations++
            Print "["+.name$+"]", .totalOperations
            while k
                   z=stackitem(k)
                   z=>operation
                   .totalOperations+=z=>totalOperations
            end while
      }
      Function final Copy {
                  k=each(.m)
                  flush ' empty current stack
                  while k
                         z=stackitem(k)
                         // append to current stack
                         Data Pointer((z=>Copy()))
                  end while
                  CC=This
                  // m is private in CC but..
                  // created in a member of same type object
                  // [] return current stack as pointer, and change current stack to a an empty one.
                  CC.m=[]
                  //  ->CC return pointer wich is a reference, but after the end of this function
                  // CC deleted. So we need a pointer of a copy of CC ->(CC) or =Pointer((CC))
                  -> (CC)
      }
      module Final addChild (child as *Componet) {
            stack .m {data child}
      }
Class:
      module Composite (.name$) {
      }
}
M->Composite("GroupA")
For M {
      // for this block M changed to a named group (hidden)
      // a name group is like a static, but not exactly.
      // we can use &This to pass a reference, or This to pass a copy (a shallow copy)
      // all public members are connected to code without use of pointer.
      .addChild pointer(Leaf("Shape1"))
      .addChild pointer(Leaf("Shape2"))
      // we can also use the pointer (which change to a reference)
      M=>addChild pointer(Leaf("Shape3"))
}
// now M change to a true pointer to a group (a nameless)
M1->Composite("Graphic")
M1=>addChild M
M->Composite("GroupB")
M=>addChild pointer(Leaf("Shape4"))
MM=M=>copy()
M1=>addChild M
M->0&
Print type$(M)="Group"  ' true
Print M is type Null = true ' true
Print M1 is type Composite and M1 is type Componet ' true
M1=>operation
Print M1=>totalOperations
List  ' Variables: if this is module a then we see A.M *[Group], A.M1 *[Group], A.MM *[Group]
Modules ? ' Modules & Functions: A, COMPOSITE(), LEAF(), COMPONET(), ICOMPONET()
Stack ' empty line, nothing in current stack
MM=>operation
Print MM=>totalOperations

Bridge Pattern (OOP)

Bridge pattern is like Adapter Pattern, but we have separate the abstraction from implementation. In Adapter pattern we need a ISomething interface for Client, and we get Adapter who inherits from ISomething. Inside Adapter is the Adaptee object. In Bridge we have a IAbstract (like ISomething) but we have more than one classes which inherits from IAbstract,  and maybe we have more than one Adaptee. Here we have a second interface the IImplementor and we have classes which inherits from it, the Implementor1, the Implementor2. The Abstract1 class comstructed with a pointer to a IImplementor type object (and all which inherits from them). We can extend IAbstract to Abstraction2 without affect the Implementor1 or Implementor2. We can extend both, IAbstract and IImplementor to Abstractrion3 and Implementor3, adding a method operation1.in Abstraction3 and operationImp2 in Implemantor3. The final M object is a IAbstract type.

\\ Bridge Pattern

class IAbstract {
      module operation {
            error "Abstract"
      }
}
Class Abstraction1 as iAbstract {
Private:
      impl=pointer()
Public:
      module operation {
            .impl=>operationImp
      }
Class:
      module Abstraction1 (p as *IImplementor) {
            .impl<=p
      }
}
Class Abstraction2 as iAbstract {
Private:
      impl=pointer()
Public:
      module operation {
            .impl=>operationImp
      }
      module operation1 {
            Print "extend Abstraction"
      }
Class:
      module Abstraction2 (p as *IImplementor) {
            .impl<=p
      }
}

Class IImplementor {
      module operationImp {
            error "Abstact"
      }
}
Class Implementor1 as IImplementor {
      module operationImp {
            Print "result from Implementor1"
      }      
}
Class Implementor2 as IImplementor {
      module operationImp {
            Print "result from Implementor2"
      }      
}
M=Abstraction1(Pointer(Implementor1()))
M.operation
M=Abstraction1(Pointer(Implementor2()))
M.operation
M=Abstraction2(Pointer(Implementor1()))
M.operation
M.operation1
\\ extends both Abstraction and Implementor
Class Abstraction3 as Abstraction2 {
Private:
      impl=pointer()
Public:
      module operation {
            .impl=>operationImp
      }
      module operation1 {
            .impl=>operationImp2
      }
Class:
      module Abstraction3 (p as *Implementor3) {
            .impl<=p
      }
}
Class Implementor3 as Implementor2 {
      module operationImp2 {
            Print "result 2 from Implementor3"
      }      
}
M=Abstraction3(Pointer(Implementor3()))
M.operation
M.operation1
Print M is type IAbstract
Print M is type Abstraction3