Παρασκευή, 13 Οκτωβρίου 2017

Event-Driven Programming in M2000

Events can be used in M2000.

1) Event object
We have to give a signature, here Read &K, z
These events have multicast function, we can add or remove functions., we can hold or release it.
Events objects are fist citizens, we can copy them, or pass as value. Events as members for groups, copied by reference, when we copy a group (a group is a value type, but we can make pointers in addition)

\\ Event-Driven Programming
Event alfa {
      Read &K, z
      function {
            Print K, z
      }
}

Group Beta {
      Private:
      K=10
      Public:
      Function Delegate1 (&M, N) {
            ' this is an event handler
            '  called with returning something
           If .K>0 then .K-- : M+=1+N
      }
      Group GetK {
            value {
                  link parent K to K
                  =K
            }
      }
}
Delta=Beta \\ we get a copy
\\Event alfa new &Beta.Delegate1()
\\ Now  we import references to alfa event
Event alfa new &Beta.Delegate1(), &Beta.Delegate1(), &Delta.Delegate1()
z=0
\\ now we can call event 10 times.
For i=1 to 10 : Call Event alfa, &z, i : Next i
Print z, Beta.GetK, Delta.GetK \\ 105, 0, 0


2) Light Events for Groups.
These events handled using static functions, in a module, without defined signature (no multicast here). When we copy a group with events, we pass weak links to service functions (for each event, without checking if these functions exist). When we call them, no error return if no such function founded). Functions are register in a list of functions/modules. Each module/function has a bigger name if it is a child one, so the list of event service functions have the big name for each, and didn't miss them. Each service routine has a name only for connecting but when run, have the same name as the parent module/function. So they have the same scope with parent. The difference is that these functions have own stack for values (when we read parameters, or doing anything), and the don't have static variables.

group withevents alfa {
       events "a","b"
       counter=1
       module dosomething (k){
              call event "a", 100*k, 200*k
              .counter++
       }
       module dosomethingelse (&x) {
              call event "b", &x
              Print "x=";x
       }
}
m=10
\\ these functions run in parent name space
Function alfa_a {
       Print "results", number/m, number/m
}
\ so we have to use Read New to ensure that we shadow an already defined z
Function alfa_b {
       Read New &z
       Print z
       z++
}
\\ z is a pointer to alfa
\\ is a weak reference  (see the counter at the end)
z->alfa
\\ z1 is a pointer to a copy of alfa
\\ now this copy holded only by the z1
z1->(alfa)
Module Inside (a, k) {
       a=>dosomething k/5
       a=>dosomethingelse &k
       Print "k=";k
}
Inside z, 500
Inside z1, 100
Print alfa.counter=2


We can make events by software only. Here we make an Event1 class (this program was one of my basic ideas to make the Event object)

\\ Process Events - Without using Event Object
\\ We make a new object Event1
Flush
Base 1 \\ work for Base 0 too
Class Event1 {
private:
      \\ first time we make an empty
      Dim cast$()
      total
      sleep
public:
      Module Add {
            .total++
            \\ this is a redim with no loss of values
            Dim .cast$(.total)
            \\ get base and add to .total-1
            Read .cast$(.total-1+dimension(.cast$(),0))
      }
      Module Hold {
            Read .sleep
      }
      Function GetStatus {
            =.sleep
      }
      Function Raise {
                  If .total=0 Then Exit
                  z=.total-1
                  m=dimension(.cast$(),0) \\ get base
                  k=Stack.size
                  If .sleep Then Flush : Exit
                  {
                        If stack.size>k Then Drop Stack.size-k
                        \\ if z>0 copy all arguments/references in stack of values
                        \\ from k element over to top - repeat k times - means copy all
                        If z>0 Then Over k , k
                        Push .cast$(m) \\ push reference to stack
                        For This {
                               \\ we need For This to make dlg temporary variable
                               \\ because we can change reference second time
                               \\ so next time dlg() get reference as first time.
                              Read &dlg()
                              \\ we don't want to process return value
                              \\ parameters for dlg are in stack
                              \\ we have to match the reading from stack
                              \\ to k elements for each Call
                              Call Void dlg()
                        }
                        z-- : m++
                        If z>=0 Then Loop
                  }
      }
}
\\ main program
\\ Three Groups
Group A {
      \\ publisher
      \\ mean I raise an Event1
      Event1 OnThis
      m=0
      Module Lock {
            .OnThis.Hold True
      }
      Module Unlock {
            .OnThis.Hold False
      }
      Module Process {
            \\ here I raise an Event1
            Read ? times
            Stack New {
                  \isolate stack with an new one
                  \also use block for loop
                  flush
                  Call .OnThis.Raise("ok", &.m)
                  Print .m, not .OnThis.GetStatus()
                  times--
                  if times>0 then loop
            }
      }
}
Group B {
      \\ subscriber
      \\ when Event1 in A raised
      total
      Function Response {
            Print "I am B and I response to Event1 "+letter$
            Read &T
            .total++
            T++
      }
}
Group D {
      \\ subscriber
      \\ when Event1 in A raised
      total
      Function Response {
            Print "I am D and I response to Event1 "+letter$
            Read &T
            .total++
            T++
      }
}
Function Anything {
      Read A$, &B
      Print "Anything", A$, B
}
For A {
      \\ add three functions by reference
      .Onthis.Add &B.Response()
      .Onthis.Add &D.Response()
      .Onthis.Add &Anything()
      \\ 3 times
      .Process 3
      .Lock
      \\ 2 times
      .Process 2
      .Unlock
      \\ 1 time
      .Process
}
Print B.total, D.total \\ 4  4


3) Gui Events
This example can work in windows and in Ubuntu Linux using Wine. Also in this example added a thread as a background task. So execution stop at line A$=Get$ where we stop for getting a key from keyboard (on console), but thread running, and event handlers work in background too. Gui events fired from form Simple, and thread fired from a clock setting on OS, which call internal task manager. Task Manager utilize two lists, one list is for running tasks and one list for waiting tasks. By default Thread.Plan is Sequential, but we can use Concurrent plan too (must change before threads used)

(add two statemends to set fonts to support character  )
We can leave these lines as is, or we canchange font name, with something else, or fontname$  a read only variable about console fontname.


Declare Simple Form
With Simple, "Title" As myTitle$
Method Simple, "FontAttr", "Arial Unicode MS", 16
Method Simple, "CtrlFontAttr", "Arial Unicode MS", 12

\\ make window, not show yet
Layer Simple {
      Linespace 60
      Font "Arial Black"
      Window 16, 8000,6000
      Cls 1,0
      Cursor 0, height div 2
      Report 2,"Hello World"
}
\\ now put a ListBox
Declare Listbox1 Listbox Form Simple
Method Listbox1, "move", 1000,1000,6000,4000
\\ and fill with some data
With ListBox1,"Text",{London
                                    Paris
                                    Athens
                                    Rome
                                    Tirana
                                    Nicosia
                                    Brussels
                                    Copenhagen
                                    Berlin
                                    Dublin
                                    Luxembourg
                                    }
\\ and set some properties, and some of them are bind to objects that are properties to objects.
\\ also when we call a method, internal a resolved done in first time, so next time a method call will be faster.
With Listbox1, "transparent", True , "ListIndex" As ListIndex, "ListCount" As ListCount
With Listbox1, "Find" As Find(),  "List" As List$()
\\ make simple sizable form (units for forms are in twips)
With Simple,"Sizable", True,"SizerWidth",90
\\ now these are the event handlers
\\ event handlers can see anything defined in parent module
\\ for this reason for &rgb we need a Read New (so a new rgb prepared before a reference assign to it)
\\ any variable can get a reference to other variable once, at defining stage.
Function Simple.Unload {
      Keyboard "!"   \\ like press !
}
Function listbox1.Color {
      Read New &rgb
            rgb=#FF7700
}
Function Listbox1.DblClick {
            Read Where
            if Right$(List$(Where),1)="✓" then {
                  List$(Where)=leftPart$(List$(Where)+" "," ")
            } else {
                  List$(Where)=leftPart$(List$(Where)+" "," ")+" ✓"
            }
            Method Listbox1,"Refresh"
            Mytitle$= List$(Where)
}
Function simple.click {
            If ListIndex>=0 Then {
                  local K$=List$(ListIndex), i
                  Method listbox1,"Sort"
                  ListIndex=Find(K$)
                  Layer {
                        \\ we print to standard cosnole layer
                        Print ">>", control$
                  }
            } Else Method Listbox1,"Sort"
}
Function Simple.Resize {
      Layer Simple {
            Mode 16
            Cls 1,0
            Cursor 0, height div 2
            Report 2,"Hello World"
            Method Listbox1,"Refresh"
      }
      \\ we put a refresh to console

      Layer { Refresh}
}
\\ now we want to show (without modal showing)
Method Simple, "Show"
\\ We can put a background task (a thread), triggering each 100 mSec
Thread {
      Print tick \\ tick is thread manager timer
} as K interval 100
a$=Key$ \\ no loop just wait a key, in console only
Threads Erase
Declare Simple Nothing



4) From COM objects   (for event service functions we have to use underscore and the name of event. Also we have to use Read New &VariableName,...(they are by reference, we use at the end $ for strings names)

This program highlight text as speak.

Module UsingEvents {
      Form 60, 32
      Cls 5, 0
      Pen 14
      Declare WithEvents sp "SAPI.SpVoice"
      That$="Rosetta Code is a programming chrestomathy site"
      margin=(width-Len(That$))/2
      EndStream=False
      \\ this function called as sub routine - same scope as Module
      \\ we can call it from event function too
      Function Localtxt {
            \\ move the cursor to middle line
            Cursor 0, height/2
            \\ using OVER the line erased with background color and then print text over
            \\ ordinary Print using transparent printing of text
            \\ $(0) set mode to non proportional text, @() move the cursor to sepecific position
            Print Over $(0),@(margin), That$
      }
      Call Local LocalTxt()
      Function sp_Word {
            Read New &StreamNumber, &StreamPosition, &CharacterPosition, &Length
            Call Local LocalTxt()
            Cursor 0, height/2
            Pen 15 {Print Part $(0), @(CharacterPosition+margin); Mid$(That$, CharacterPosition+1, Length)}
            Refresh
      }
      Function sp_EndStream {
            Refresh
            EndStream=True
      }
      Const SVEEndInputStream = 4
      Const SVEWordBoundary = 32
      Const SVSFlagsAsync = 1&

      With sp, "EventInterests", SVEWordBoundary+SVEEndInputStream
      Method sp, "Speak", That$, SVSFlagsAsync
      While Not EndStream {Wait 10}
      Call Local LocalTxt()
}
UsingEvents

Another variant, which write text as speaks

Module UsingEvents {
      Form 60, 32
      Declare WithEvents sp "SAPI.SpVoice"
      That$={Rosetta Code is a programming chrestomathy site.
      The idea is to present solutions to the same task in as many different languages as possible, to demonstrate how languages are similar and different, and to aid a person with a grounding in one approach to a problem in learning another. Rosetta Code currently has 913 tasks, 214 draft tasks, and is aware of 707 languages, though we do not (and cannot) have solutions to every task in every language.}
      EndStream=False
      LastPosition=-1
      TxtWidth=0
      Function sp_Word {
            Read New &StreamNumber, &StreamPosition, &CharacterPosition, &Length
            Rem: Print StreamNumber, StreamPosition , CharacterPosition, Length
            If LastPosition=CharacterPosition Then exit
            LastPosition=CharacterPosition
            Local f$=" "
            If TxtWidth=CharacterPosition+length Then f$=". "
            If length+pos+2>width then Print
            Print Mid$(That$, CharacterPosition+1, Length);f$;
            If f$=". " Then Print
            Refresh
      }
      Function sp_EndStream {
            Refresh
            EndStream=True
      }
      Function sp_Sentence {
            Read New &StreamNumber, &StreamPosition, &CharacterPosition, &Length
            if Length>0 and not CharacterPosition=0 then Print
            Print "  ";
            TxtWidth=CharacterPosition+Length-1
      }
      Const SVEEndInputStream = 4
      Const SVEWordBoundary = 32
      Const SVESentenceBoundary = 128
      Const SVSFlagsAsync = 1&

      With sp, "EventInterests", SVEWordBoundary+SVEEndInputStream+SVESentenceBoundary
      Method sp, "Speak", That$, SVSFlagsAsync
      While Not EndStream {Wait 10}
      Wait 100
}
UsingEvents

Δεν υπάρχουν σχόλια:

Δημοσίευση σχολίου