Κυριακή 25 Δεκεμβρίου 2022

Revision 25 Version 11

Revision 25 is the last revision for version 11. The new version 12 prepared now. This release remove two things:

1. Fix in lambda some fault code (introduced by last revision), the conv2 module in Info can be run.

2. Change of a system timer (now using one from Kernel32). The old one cause problems in Windows 10 (returning negative values earlier than 25 days, unexpected). So this bug removed (which logical is impossible to return negative value - the timer has a cycle of 49 days, so the timer beginning  from 0 at startup, has to run for the half of that duration, to became negative (as VB6 read it as signed Long - it is unsigned although, but the bits are the same, so when 32th bit turned to 1, we get  negative value by the casting to signed Long, which VB6 use). When the bug happen, the M2000 which just called not show the console and stay in a step before opening the console. So we have to close it from Task Manager.


About the 12th version (I do some additions and tomorrow expected to finish it) :

1. We have a new way to define/redefine local variables:

Double a, b=100 ,c

if variable a exist as long then change to double (the old value erased).

Version 11 has the Def double a, which works in Version 12. This statement if find a as local raise error.

2. We can use the new types string and variant..

The string type make string using names like the numbers. Until version 11 we have to use $ for the names of strings, so A$ is a string variable (a$ and A$ are the same). Now we can use A as string too (but isn't the same as A$, these are two different variable names). Functions like Mid$() now take A too if A is string type.

version 11 and 12

alfa("George")
alfa()
sub alfa(a$="World")
Print "Hello "+a$
end sub

Version 12

alfa("George")
alfa()
sub alfa(a as string="World")
Print "Hello "+a
end sub

Variant Type.

The variant type is a variable which can change types. Here we pass it by reference and change type in the Beta sub.

Version 11, no variant type, a variable can't change type (only for those we make in console, as global variables, can change types, and array items.

Module TestThis{
// when a variable get first value then the type locked
a=100
// if string has numeric value the this value change to number
a="12345"
Print a=12345
}
TestThis

This is the same for Version 12, but we have the Variant type, which do the job:

Variant a=100

Print a=100, type$(a)="Double"
a="Hello"
a+=" World"
Print a="Hello World", Type$(a)="String"
Beta(&a)
Print Type$(a)="mArray"
Sub Beta(&z as variant)
z=(1,2,3,4)
End sub

As you see, to use the Variant Type and String with same name as the numeric variables, there was a big step, because there are changes to evaluator, the IsExp and IsStrExp internal variables which use a look ahead function to find before execution if the code seams to be numerical expression (including comparisons and logical expressions) and  or seams to be string expression. So in Version 11 the expression a$+b$=c$+d$ and X>10  without checking if identifiers exist, looking the $ and the symbols + = (and others like this in other expressions) get the idea that is a numerical expression (this return a Boolean value, we have two comparisons and the AND - the knowing as logical gate AND). The look ahead procedure skip anything in parenthesis. So the A*(B+12)+C is like A*X+C for that system. Also M2000 execute all the subexpressions (even if the result for first operand is False). M2000 always execute an expression in the order we write, and process the subexpressions when the results computed. So 1*2*3+4*5*6, get 1 , find * and from that point see if there is an open parenthesis and if true then start a new IsExp, For version 12 the string variable can be found in an accepted numeric expression as the look ahead system found it: so a+a can be an addition for strings or numbers. I found a way to overcome this without breaking the normal look ahead system for numeric expressions. I have to handle the way in IsStrExp  using a bypass of the lookahead. For some code which written using for a parameter (from M2000 user code, the source) either type, string or numeric, I don't use the bypass and if isn't say string expression, the isExp do a better job and find it.

Version 12

function alfa {
// ="alfa"  // can't use "bare" this, we get error, expected numeric type
variant a="hello"
=a
}
Print alfa()+" World"

See that if we use ="alfa" for return value we get error (the look ahead function check if the result is compatible with function type (only by name, if  character $ exist). (we need to check this for the normal use of functions, this language designed for pupils). The Print function call IsExp first, which use the look ahead and find that this has a numeric something  (parenthesis skipped) at least, so begin to execute, and get the string type from alfa() and then take the symbol "+" and check to see what come next and find string literal and start to process a string expression, and at the end return the string value " World"  and at the  "+" checking that there are two operands of type string so do the addition and return the result (as a numeric result). At the returning I have to use a type checking, and if I can use the string value is ok, if not the return value is 0.

What happen to these statements: 

a="Hello"
z$=a
Print z$

The z$ expect a string expression. In Version 11 the look ahead works and see there is no string expression, so return error without process the expression. In Version 12, the expression processed, and the return type is string so it accepted. This is an error for Version 12 (and for Version 11), but in Version we don't have process of the expression after the Z$=.

a=10
z$=a

So now I will fix the Variants for Groups. I have to add arrays of specific types, Version 11 and smaller use variant type, so the name only used to get the number or the string from the value.

// version 11 and version 12
Dim A(2)
A(0):="hello",2
Link A() to A$()
Print A(0), A(1) ' print  0  for A(0) the hello isn't numeric
Print A$(0), A$(1) ' print 2 as string left justified
Print A() ' print automatic all elements in each tab position, finding types
Print A$() ' the same as before
A$(0)="12345"
Print A(0)=12345 ' convert to number each time we use A(0)
A(0)=12345
Print A(0)=12345 ' now we have number
Print A() ' print automatic all elements in each tab position, finding types
Print A$() ' the same as before

After the Version 12 complete with arrays of specific types like this Dim a() as string, b() as long I have to go to a new Interpreter using a Virtual Machine,  I have made the variable system look here



Τρίτη 13 Δεκεμβρίου 2022

Αναθεώρηση 20 Έκδοση 11

Έγιναν πολλές αλλαγές, οπότε εδώ θα γράψω μόνο για τις πιο σημαντικές.

1. Από αυτή την αναθεώρηση δουλεύουν και οι Long Long ακέραιοι (64 bit). Στα ελληνικά Μακρύς Μακρύς.


2. Μπήκε η δυνατότητα χρήσης εξωτερικών στοιχείων στις φόρμες. Έχουν ήδη περαστεί πέντε στοιχεία στο περιβάλλον της Μ2000, και έτσι προσθέτουμε το πρόθεμα Μ2000 και τελεία πριν το όνομα του στοιχείου (δείτε τα παραδείγματα). Μπορούμε να φτιάξουμε και πίνακες στοιχείων. Το ιδιαίτερο εδώ είναι ότι προς το παρόν λαμβάνουμε σε όλα τα γεγονότα τιμές με πέρασμα με αναφορά. Αυτό σημαίνει ότι θα βάζουμε το & πριν το όνομα μεταβλητής. Επίσης σημαίνει ότι αν πράγματι είναι με αναφορά τα παραδοτέα, από το αντικείμενο, θα επιστραφούν τιμές αν τις αλλάξουμε. Τα νέα στοιχεία δεν είναι δικά μου και αναφέρονται τα ονόματα αυτών που τα έφτιαξαν στο πηγαίο κώδικα, στο GitHub.

To ucChart, το ucPieChart είναι του Leandro Ascierto., το στοιχείο με τα πολλά σχήματα, είναι του Eduardo δείτε εδώ:  https://github.com/EduardoVB/ShapeEx,  το εκπληκτικό ctxNinePatch, του Vladimir Vissoultchev  (χρησιμοποιεί png αρχεία τύπου 9 patch.) και το "ταχύμετρο" του  Γερμανού Olaf.


Το στοιχείο ucChartArea, έχει γραφτεί στο κώδικα της Μ2000 και για το λόγο αυτό δίνουμε το όνομα M2000.ucChartArea; Αλλιώς αν ήταν "καταχωρημένιο" στον υπολογιστή θα μπορούσαμε να το φορτώνουμε από το σύστημα. Δείτε ότι χρειάζεται να δίνουμε τα στοιχεία σε Collection της VB6.  Οπότε υπάρχει μια συνάρτηση που δίνει αυτόματα δείκτη σε νέα λίστα.


function newCollection {
declare list1 Collection
=list1
}
flush


declare FORM1 form
declare Chart type "M2000.ucChartArea" form FORM1
Method FORM1,"move", 1000, 1000, 14000, 12000
Layer Form1 {Gradient 11, #7777aa}
With Chart,"BackColorOpacity", 0, "title", "Chart Example", "LinesCurve", true
Method Chart,"move", 1000, 1000, 12000, 10000


data  "Enero", "Febrero", "Marzo", "Abril", "Mayo", "Junio"
Value1=newCollection()
while not empty
method Value1, "add", letter$
end while
Method Chart, "AddAxisItems", Value1
Value1=newCollection()
Data 2,5,7,-10, 5, 10
while not empty
method Value1, "add", number
end while
Method Chart, "AddLineSeries", "2007", Value1, color(255,0,0)
Data 8, 4, 45, -15, 9, 14
Value1=newCollection()
while not empty
method Value1, "add", number
end while
Method Chart, "AddLineSeries", "2008", Value1, color(0,0,255)
Value1=newCollection()
Data 14, 8, 16,4, 24, 3
while not empty
method Value1, "add", number
end while
Method Chart, "AddLineSeries", "2009", Value1, color(0,255,0)
function form1.click {
layer form1 {
Gradient random(7,14), #7777aa
refresh
}
}
function Chart.MouseMove(&A, &B, &X, &Y) {
Print A, B, X, Y
Refresh
}
function Chart.Click() {
Print "Thank you"
refresh
}
METHOD FORM1 "SHOW", 1


declare FORM1 NOTHING








3.'Εφτιαξα  Δυο νέες κλάσεις για πίνακες και λίστες με κλειδιά, που μπορούν να χρησιμοποιούν όποιο τύπο θέλουμε. Η διαφορά με τους πίνακες της Μ2000 είναι ότι εδώ έχουμε πίνακες με ένα τύπο. Πχ 1000 αριθμοί Long (Μακρύς) είναι 4000 bytes συν μια κρυφή δομή των 16 Bytes. Ενώ ο τωρινός πίνακας της Μ2000 είναι τύπου Variant,  με 16 Bytes για το κάθε στοιχείο, άρα 16000 bytes ή τρεις φορές περισσότερα σε σχέση με τους απλούς πίνακες. Υπάρχουν πολλοί λόγοι που φτιάχτηκαν αυτές οι δυο κλάσεις. Ίσως φτιάξω κατάλληλο interface για να γίνουν πολυδιάστατοι όπως της Μ2000. Προς το παρόν ένα αντικείμενο refArray έχει έναν κεντρικό πίνακα που παίρνει πίνακες. Ο κεντρικός είναι ας πούμε οι στήλες. Σε κάθε στήλη μπορούμε ή να βάλουμε μια τιμή (χωρίς πίνακα) ή ένα πίνακα. ενός τύπου, ή έναν Variant (γιατί και αυτό υπάρχει ως τύπος), ή ένα άλλο αντικείμενο, ακόμα και άλλα refArray. Το όνομα σημαίνει πίνακας με αναφορά, γιατί στην ουσία έχουμε έναν δείκτη στο αντικείμενο, και αυτό κρατάει όλους τους διαμορφωμένους πίνακες, σε τύπο και ποσότητηα. Έχει συνάρτηση αντιγραφής  To HashList παίρνει κλειδιά αλφαριθμητικά ή αριθμητικά (ή και τα δύο μαζί, αλλά ένα για κάθε στοιχείο). Αυτός ο τύπος λίστας χρησιμοποιεί το ref Attay. Προς το παρόν μόνο να αυξήσουμε μπορούμε το μέγεθος των πινάκων.


4. Ανανεώθηκε το QR Code (στο δικό του GutHub και εδώ στη Μ2000). Η έκδοση του QR Code με στρογγυλάδες είχε πρόβλημα. Τώρα λειτουργεί σωστά. Αυτή είναι η εικόνα που του έστειλα για να δει το πρόβλημα, και ανταποκρίθηκε γρήγορα, ο προγραμματιστής.




Τρίτη 29 Νοεμβρίου 2022

Simple Database (RosettaCode task)


Write the code on a UTF-8 text file as tool.gsb

Assign gsb files to open with M2000.exe (the M2000 environment)

Open the folder where exist tool.gsb in a cmd window

then follow the > lines in the out session

The format of file is xml, Utf8 with a BOM.

The M2000 environment not used here, all the output redirect to console. (Although the environment is a Window program, we can attach the console).

first time the program make a tool.bat

>tool.gsb


So now we can call the tool bat.

>tool

Commands:

tool add name "anyname" tag "tagtext" date "YYYY.MM.DD.HH:MM"

tool latest

tool latest-per-tag

tool all-entries


>tool add name "BOB" tag "EAT A LOT" date "2022.10.21.04:00"

>tool add name "JOHN" tag "DRINK WATER" "date 2022.10.15.12:00"

>tool add name "PAUL" tag "EAT A LOT" date "2022.10.13.22:00"

>tool add name "SUZAN" tag "DRINK WATER" date "2022.10.13.12:00"

>tool add name "PHILIP" tag "DRINK WATER" date "2022.10.13.10:00"

>tool add name "MONDY" tag "EAT A LOT" date "2022.10.10.12:00"

>tool add name "MARY" tag "PIZZA FRIENDLY" date "2022.10.10.12:00"

>tool add name "DONALD" tag "PIZZA FRIENDLY" date "2022.10.10.02:00"

>tool add name "GEORGE" date "2022.11.29.16:55"


This is the last print from last tool addd:

<?xml version="1.0" encoding="utf-8-sig"?>

<MyFile>

    <Row name="BOB" tag="EAT A LOT" date="2022.10.21.04:00"></Row>

    <Row name="PAUL" tag="EAT A LOT" date="2022.10.13.22:00"></Row>

    <Row name="SUZAN" tag="DRINK WATER" date="2022.10.13.12:00"></Row>

    <Row name="PHILIP" tag="DRINK WATER" date="2022.10.13.10:00"></Row>

    <Row name="MONDY" tag="EAT A LOT" date="2022.10.10.12:00"></Row>

    <Row name="MARY" tag="PIZZA FRIENDLY" date="2022.10.10.12:00"></Row>

    <Row name="DONALD" tag="PIZZA FRIENDLY" date="2022.10.10.02:00"></Row>

    <Row name="GEORGE" date="2022.11.29.16:55"></Row>

</MyFile>



>tool latest

The latest entry is:

GEORGE,,2022.11.29.16:55


>tool latest-per-tag

latest entry for each tag:

GEORGE,,2022.11.29.16:55

PHILIP,DRINK WATER,2022.10.13.10:00

MONDY,EAT A LOT,2022.10.10.12:00

DONALD,PIZZA FRIENDLY,2022.10.10.02:00


>tool all-entries

All entries sorted by date:

DONALD,PIZZA FRIENDLY,2022.10.10.02:00

MONDY,EAT A LOT,2022.10.10.12:00

MARY,PIZZA FRIENDLY,2022.10.10.12:00

PHILIP,DRINK WATER,2022.10.13.10:00

SUZAN,DRINK WATER,2022.10.13.12:00

PAUL,EAT A LOT,2022.10.13.22:00

BOB,EAT A LOT,2022.10.21.04:00

GEORGE,,2022.11.29.16:55



V1.1 Added msg box if you load it from M2000 console

To edit the code from console use Edit "tool.gsb" this open the file for edit and at the exit save it (you can use Shift F12 to skip saving (drop changes). Edit using string open editor, and if the file extension is gsb then we get syntax coloring. You can find txt file using File "txt"

menu  // clear menu internal array
files + "txt"  // fill menu array using names of file .txt from current directory
menu ! // open menu using internal array
if menu<>0 then
// edit text - use Esc to exit - use Shift F12 to drop changes and exit
edit menu$(menu)+".txt"
end if

The editor use the split screen, so you can make a split, say Cls, 12  (from 13th row, see the comma, we use the same color  (as from last CLS) for clearing the low part of screen). We can use SCROLL SPLIT 12 to set the split row without clearing any part of screen. The editor open on a control, above the screen. This editor open when we use Edit.Doc for documents (we can use transparency, so we edit text above a background image). Although Edit and Edit.Doc use the split row, and  full with, there is another statement, Input which can be used to get text from a user defined area on the screen. Also for user forms (Input/Key$/Inkey$ can't be used for those type of layers) we have controls like EditBox and TextBox for input text, and EditBox for multiline text (has a programmable syntax coloring system). There are some interesting modules in Info (Info.gsb, we get it with setup, or you can download from github), like MEditor (A Form to edit M2000 programs, in a form, with two Editbox controls, one for edit code and another one for help, also this use a control to alter the size of boxes as split control), CS a csharp editor (you can compile csharp programs), htmlEditor (for html/css), and see the Wind4 (picj randomly one of 5 types for input for M2000 console, including two for multiline text, Edit.Doc and  an Input variation)






MODULE GLOBAL interpret {
global filename$="base1.xml"
module latest {
PrintConsoleLn("The latest entry is:")
if exist(filename$) else exit
declare xml xmlData
with xml, "xml" as doc$, "beautify" as beautify
doc$=string$(eval$(buffer(filename$)) as UTF8dec)
with xml, "lastchild" set child
with child,"attr" as attr$()
PrintConsoleLn(attr$("name")+","+@tag$()+","+attr$("date"))
declare xml nothing
}
module latestForEachTag {
PrintConsoleLn("latest entry for each tag:")
if exist(filename$) else exit
declare xml xmlData
with xml, "xml" as doc$, "beautify" as beautify
doc$=string$(eval$(buffer("base1.xml")) as UTF8dec)
with xml, "firstchild" as firstchild
child=firstchild
with child,"attr" as attr$()
inventory alfa
do
if not exist(alfa, @tag$()) then
append alfa, @tag$():=child
else
return alfa, @tag$():=child
end if
Method xml, "EndOffChilds", &child as ok
when ok
sort alfa
k=each(alfa)
while k
child=eval(k)
PrintConsoleLn(attr$("name")+","+@tag$()+","+attr$("date"))
end while
declare xml nothing
}
module All {
PrintConsoleLn("All entries sorted by date:")
if exist(filename$) else exit
declare xml xmlData
with xml, "xml" as doc$, "beautify" as beautify
doc$=string$(eval$(buffer("base1.xml")) as UTF8dec)
with xml, "firstchild" as firstchild
child=firstchild
with child,"attr" as attr$()
inventory alfa
i=0
do
// prevent same keys using a unique patch key
append alfa, attr$("date")+str$(i,"000000"):=child
i++
Method xml, "EndOffChilds", &child as ok
when ok
sort alfa
k=each(alfa)
while k
child=eval(k)
PrintConsoleLn(attr$("name")+","+@tag$()+","+attr$("date"))
end while
declare xml nothing
}
module add (line$) {
line$=trim$(line$)
if line$="" then exit
declare xml xmlData
with xml, "xml" as doc$, "beautify" as beautify
bom$=str$(format$("\uef\ubb\ubf"))
//  len(bom$)=1.5 (1.5*2=3 bytes)
k=0
if exist(filename$) then try {k=filelen(filename$)}
if k<10 then
method xml, "PrepareNodeSimple", "xml" as ProcessInstructions
method xml, "PlaceAttributeToNode", ProcessInstructions, "version", "1.0"
method xml, "PlaceAttributeToNode", ProcessInstructions, "encoding", "utf-8-sig"
method xml, "PlaceProcessingInstructions", ProcessInstructions
method xml, "PrepareNode", "MyFile" as Node
method xml, "InsertNode", Node
else
doc$=string$(eval$(buffer(filename$)) as UTF8dec)
end if
a$=""""+line$
def name$, tag$,date$
do
a$=rightpart$(a$, """") : what$=lcase$(trim$(leftpart$(a$, """")))
if what$="" then exit
a$=rightpart$(a$, """") :par$=leftpart$(a$, """")
select case what$
case "name"
name$=par$
case "tag"
tag$=par$
case "date"
date$=par$
end select
always
if name$<>"" and date$<>"" then
method xml, "PrepareNode", "Row", "" as Node1
method xml, "PlaceAttributeToNode", Node1, "name", name$
if tag$<>"" then method xml, "PlaceAttributeToNode", Node1, "tag", tag$
method xml, "PlaceAttributeToNode", Node1, "date", date$
method xml, "AppendChild", Node1
open filename$ for wide output as #f
print #f, bom$;string$(doc$ as UTF8enc);
close #f
beautify=-4
PrintConsoleLn(doc$)
end if
declare xml nothing
}
declare FreeConsole lib "Kernel32.FreeConsole"
declare GetStdHandle lib "Kernel32.GetStdHandle" {long a}
declare AttachConsole lib "Kernel32.AttachConsole" {long a}
declare CloseHandle lib "Kernel32.CloseHandle" {long a}
declare global WriteCons Lib "Kernel32.WriteConsoleW" {long cons, a$, long n, Long p, long u}
long STD_OUTPUT_HANDLE=-11
global retvalue
buffer clear retvalue as long
ret=AttachConsole(-1)
global m=GetStdHandle(STD_OUTPUT_HANDLE)
if ret=0 then
beep
push Ask("Run from cmd line","Problem",,"")
drop
exit
end if
if not islet then
try {
open "tool.bat" for output as #f
print #f, {@}+appdir$+{m2000.exe data {%*}: dir %cd%:load tool
}
close #f
}
PrintConsoleLn("")
dos "tool.bat"

else
read cmd$
cmd$=trim$(cmd$)+" "
select case lcase$(leftpart$(cmd$, " "))
case "add"
add rightpart$(cmd$," ")
case "latest"
latest
case "latest-per-tag"
latestForEachTag
case "all-entries"
all
case else
help()
end select
end if
call void closehandle(m)
call void freeconsole()


Sub PrintConsole(a$)
      Call Void WriteCons(m, a$, Len(a$), retvalue(0), 0)
End Sub
Sub PrintConsoleLn(a$)
a$+={
}
Call Void WriteCons(m, a$, Len(a$), retvalue(0), 0)
End Sub
function tag$()
try {
=attr$("tag")
}
end function
Sub Help()
h$={Commands:
tool add name "anyname" tag "tagtext" date "YYYY.MM.DD.HH:MM"
tool latest
tool latest-per-tag
tool all-entries
}
PrintConsole(h$)
End Sub
}
module interpret1 {
try {interpret}
}
interpret1: end



Δευτέρα 28 Νοεμβρίου 2022

Revision 19 Version 11

 Some bugs removed, one was rare and for that reason difficult to understand, but I found it. 

This is the priority1 example in info (new example). This example make a priority queue (and a second one to show the merging function). In previous revisions, this run without error but the outcome has a missing string; Now run as expected. The problem was on the operator ">" , there is a missing of a simple statement to "clear" a specific "state" (the use of pointer to group).


This example use a class obj to make objects which hold two things, the priority level  x (low value means bigger priority) and the task name. Also we have to handle two or more tasks with same priority.

A class by default is a function which return an object (not a pointer to object). The object indeed has a pointer, but the interface has specific state to indicate the way we can use. so if we execute the statement: A=obj(1, "task title1") we get a Group, named A as bound to module/function we have this code. This group A deleted at the exit/ end of execution of module/function. This group called named group. It has a name, so we can pass it by value, or by reference like ordinary variables. If B is another named group. then A=B is a copy of B state to A state. So we understand here that A and B has no "useful" pointers. Also if we have array Alfa(1 to 10) we can do this Alfa(1)=obj(1, "task title1") which make the item at index 1, on array Alfa(), to hold an object, but not a useful pointer, at this moment. This object's life extended to Alfa() life or the assigning of a new object for the specific array item. A function may return the array, so the group in the array is like a "float" group. It goes where the container (here an array, but can be a list, or a stack). This was the way to use groups before the introducing of pointers to groups. The old way was very safe because actually the hidden pointer to group object exist only once, so there was no way to make tight link between objects, which prevent the "death", or the removing/deleted the resources which hold. All objects die when the last pointer deleted, utilizing a counter on the object state (or memory). So the simple object with a unique pointer, stayed either in variable in a module, which at the end of execution of that module the variable erased, causing the counter of pointer references to became zero. The same for the "containers", when the last pointer for a container erased, the items also erased, and everywhere there is an object of type group, that object deleted. So this can be change when we use multiple pointers for the same object of type group.

You can see in this example the use of g() function, a global function which return a pointer to group. A pointer is like a numeric value, looking the identifier, but it is "object" type. There are two kinds of pointers, and the "holded", the variable (the identifier) can use any of the two. One of them is the simple weak reference. If the A group is defined as named group in the current module, then th C->A or C=Pointer(A) define a pointer C as weak reference. So this C can be valid until the end of execution of the current module (or function). Let say group A has a property X a numeric one, then the Print A.X  print this, the AnotherModule &A.X pass the property by reference,  (we have to use &ParameterName from the other side of call, to get the weak reference and make it a strong reference). References are Identifiers which show to memory to another identifier, and can't change to show something else.  When references erased nothing happen to original value, Pointers are the tickets to travel with objects, and when the pointers erased, the objects removed from system. If A is a pointer to a group, we can use by reference pass, which means we may have B as a reference to A which is a pointer. If we pass a new pointer to B then A get this pointer too, because there is one place to hold pointer, the place of A, and B has a reference only o that place (this isn't weak, but strong, the B has a Hard Link to A). Its clear, a reference "die"  before the original identifier, except we hold the weak reference but 100% the use of the weak reference, at the time after the death of original identifier, will cause troubles,

Pointer() without parameter is the Null object, which is of type Group. We can't extend a class using the Null object. But we can put this in a pointer of group to decrement the "life counter", the counter of pointers which "refer" to group. The kind of  pointer as weak reference has no counting effect. The group dies at specific moment.

So how we can make original pointers;

Let say that A is a group, a named group. So the Beta->(A) or Beta=Pointer((A)) make a copy of A and return a pointer to this copy. If A(1) has a group then the Beta->A(1) make the two of them pointers to group (if A(1) was not a pointer to group, then change). So if we have a property X (as variable or as a group inside which we can set values, or read values or both), we can use Print Beta=>X and Beta=>X=100, and we will see that A(1).X has value 100.

So lets see PriorityQueueForGroups module. In this module we use some Subs, and simple Functions. These two kind of "named code" (called using names), are written at the end of the body of module, and they use the same namespace as of the module, so from a sub we can call any sub included in the module, and any function too. This not hold for functions/lambda functions/Modules because from that we can call anything we define only there, and any global. We can say, subs and simple functions (called with @ prefix) are used when we have state to share. We can say that modules, functions and lambda functions (which have closures), are designed to operate as units, holding separate state (modules and functions can use static variables, but this is something rare) at the moment of call, and then the next call we have a "resetting" code, to start again. So the outcome from these are predictable (but no always if we look "outside" and that change the behavior of the code). On  top of these two worlds, we have the Groups. These have state on board, and methods, and also they have private members, to allow only own methods to change them.

So the obj class has private members the X and S$ variables. So when we make an object given a priority number and a task name we haven't a way to change them (but we can define a new one and replace the pointer everywhere we hold a pointer to "old data".


All the tasks held by groups which held by a stack. The stack is a collection of values. A stack is a modified Vb6 Collection, which hold a "carrier" object (which Interpreter get them from a pool of free objects, eliminating the creation/removing of thes). That object named VarItem may hold numbers of many types, strings, objects of any kind. So here we place the pointers from g() functions, pointers to obj type object. The priority queue is a stack object and we place in an order the "task". Every time a new task added, we looking for a position to insert it, using binary search. To compare the tasks we have an operator defined in obj class. Also we have  a copy function which return a pointer to a copied "float" group. Also there is a tostring$ to show results. There is a remove method which called when a float group lost all pointer to it. (in fact there is another pointer, which we use before the final "shutdown'. Variable countmany (a long type) used to write how many objects used, i a session, of M2000 Interpreter.

Thats all for now.


global countmany=0&
class obj {
private:
      x, s$
public:
      operator ">" {
            read k as *obj
            push .x>k=>x
      }
      property toString$ {
            value (sp=8) {
                  link parent x, s$ to x, s$
                  value$=format$("{0::-5}"+string$(" ", sp)+"{1:20}", x, s$)
            }
      }
      function Copy {
            countmany++
            z=this
            =pointer((z))
      }
      remove {
            countmany--
      }
class:
      module obj (.x, .s$) {countmany++}
}
// obj() return object as value (using a special pointer)
function global g(priority, task$) {
// here we return an object using nonrmal pointer
// try to change -> to = to see the error
->obj(priority, task$)
}
Module PriorityQueueForGroups (emptysecndqueue as boolean) {
      Flush ' empty current stack
      Data g(3, "Clear drains"),g(4 ,"Feed cat"), g( 5 , "Make tea")
      Data g( 1 ,"Solve RC tasks")
      ObjectCount()
      pq=stack
      zz=stack
      while not empty
            InsertPQ(pq) // top of stack is pq then objects follow
      end while
      Pen 15 {
            data g(2 , "Tax return"), g(1 ,"Solve RC tasks#2")
            while not empty: InsertPq(zz): End While
            n1=each(zz,-1,1)
            Header()
            while n1
                  Print @Peek$(stackitem(n1))
            end while
      }
      MergePq(pq, zz, emptysecndqueue)
      InsertPq(pq, g(1 ,"Solve RC tasks#3"))
      ObjectCount()
      Print "Using Peek to Examine Priority Queue"
      n1=each(pq,-1, 1)
      Header()
      while n1
            Print @Peek$(stackitem(n1))
      end while
      ObjectCount()
      Header()
      while not @isEmpty(pq)
            Print @Pop(pq)=>tostring$
      end while
      ObjectCount()
      Header()
      while not @isEmpty(zz)
            Print @Pop(zz)=>tostring$
      end while
      ObjectCount()
      // here are the subs/simple functions
      // these are static parts of module
      sub Header()
            Print " Priority        Task"
            Print "==========  ================"
      end sub
      sub ObjectCount()
            Pen 10 {Print "There are ";countmany;" objects of type obj"}
      end sub
      sub MergePq(a, pq, emptyqueue)
            local n1=each(pq, -1, 1), z=pointer()
            while n1
                if emptyqueue then
                    stack pq {
                        shiftback len(pq)
                        InsertPQ(a, Group)
                    }
                else
                    z=stackitem(n1)
                    InsertPQ(a, z=>copy())
                end if
            end while
      end sub
      sub InsertPQ(a, n as *obj)
            Print "Insert:";n=>tostring$(1)
            if len(a)=0 then stack a {data n} : exit sub
            if @comp(n, stackitem(a)) then stack a {push n} : exit sub
            stack a {
                  push n
                  local t=2, pq=len(a), t1=0
                  local m=pq
                  while t<=pq
                        t1=m
                        m=(pq+t) div 2
                        if m=0 then m=t1 : exit
                        If @Comp(stackitem(m),n) then t=m+1: continue
                        pq=m-1
                        m=pq
                  end while
                  if m>1 then shiftback m
            }
      end sub
      function comp(a as *obj, pq as *obj)
            =a>pq
      end function
      function Peek$(a as *obj)
            =a=>toString$
      end function
      function IsEmpty(a)
            =len(a)=0
      end function
      function Pop(a)
            // Group make a copy (but here is a pointer of group)
            stack a {shift stack.size
            =Group}
      end function
}
pen 11 {Print "Priority Queue - Merging and removing items from second Queue"}
PriorityQueueForGroups true
Print "press a key": Push Key$: Drop
Pen 11 {Print "Priority Queue - Merging without removing items from second Queue"}
PriorityQueueForGroups false