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

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

Complex Numbers (part 1)

This part has two final classes, the DoubleComplex() and the FloatComplex. Each class define objects of general type Group, with types DoubleComplex & Complex, and FloatComplex & Complex.

Each class has a constructor/ In each constructor we make a Buffer of two at least numbers, for Double Complex we use double type (8bytes per number), for the other we use Single type (4 bytes per number). Each constructor can take 1 to 3 arguments, the first is the real number, the second is the imaginary number and last is how many complex numbers we need. 

We make Value and Set methods to handle the way we assign values and read values from these objects. After we define an object we can assign a new value either from same type or using the another type but from base class Complex.

Just look the code.

Class Complex {
Private:
	k, lim=0
	Function copy {
		=group(this)
	}
Public:
	Property Ptr {
		value {link parent k to k: value=k(0)}
	}
	Property Ubound {
		value {link parent lim to lim: value=lim}	
	}
	Final Lbound=0&
	// we use clear to clear value variable which property define as double by default
	// using Property a { }=0& we can define the value as long
	// but here we use Real for two different buffers, one with type double and one with type single
	Property Real {
		value {clear:link parent k to k: value=eval(k,0)}
	}
	Group Real {
		operator "++" {
			link parent k to k: Return k, 0:=eval(k, 0)+1
		}
	}
	Property Imaginary {
		value {clear:link parent k to k:	value=eval(k,1)}
	}
	Group Imaginary {
		operator "++" {
			link parent k to k: Return k, 1:=eval(k, 1)+1
		}
	}
	Property toString$ {
		 value {
		 	Link parent k, lim to k, lim
		 	read ? where=0&
		 	if where<0 or where>lim then error "Index out of bound"
		 	where*=2
			m=eval(k,where+1)
			if m==0 then
				 value$=format$("({0})",eval(k, where))
			else.if eval(k,0)==0 then
				u$="({1}i)"
				value$=format$("({0}i)",eval(k,where+ 1))
			else
				if abs(m)==1 then u$="({0}{2}i)" else u$="({0}{2}{1}i)"
				value$=format$(u$,eval(k, where),abs(m), IF$(m<0->"-","+"))
			end if
		}
	}
	Function Export$() {
		=eval$(.k)
	}
	Module Import (This$) {
		m=len(This$)*2
		if m>0 and m<=len(.k) then
			Return .k, 0:=This$
		end if
	}
	Module SwapBuffers (&a as Complex){
		if .len<> a.len then  Error "Not compatible buffers"
		swap .k, a.k
		swap .lim, a.lim
		
	}
Class:
	Module Complex {
		Error "Can't define objects"
	}
}
Class DoubleComplex as Complex {
Private:
	len=16
	Function newDoubleComplex(a as DoubleComplex, w) {
		buffer z as double*2
		return z, 0:=eval$(.k, w*.len!, .len)
		let a.k=z, a.lim=0  // k is Private in a
		=group(a) 
	}
	Function copyme(a as DoubleComplex) {
		buffer z as double*2*(a.lim+1)
		return z, 0:=eval$(.k)
		let a.k=z
		=group(a) 
	}
Public:
	Operator "+"  {
		read a as Complex
		let this=.newFloatComplex(this, 0)
		return .k, 0:=eval(.k,0)+a.real, 1:=eval(.k, 1)+a.imaginary
	}
	Operator "-"  {
		read a as Complex
		let this=.newFloatComplex(this, 0)
		return .k, 0:=eval(.k,0)-a.real, 1:=eval(.k, 1)-a.imaginary
	}
	Set () {
		read a as Complex
		read ? where=0&
		if where<0 or where>.lim then error "Index out of bound" else  where*=2
		if a is type FloatComplex then
			return .k, where:=a.real, where+1:=a.imaginary
		else.if a is type DoubleComplex then
			return .k, where:=eval$(a.k)
		else
			error "can't assign this group"
		end if
	}
	Module Redim (many as long) {
		if many<1 then error "Wrong Dimension"
		buffer clear .k as double*2*many: .lim<=many-1
	}
	Module RedimPreserve (many as long) {
		if many<1 then error "Wrong Dimension"
		buffer .k as double*2*many: .lim<=many-1
	}
	Function final copy {
		=.copyme(this)
	}
	value () {
		read ? where=0&
		if where<0 or where>.lim then error "Index out of bound"
		 
		 if where=0 and .lim=0 then
		 	=this
		 else
	 	 	=.newDoubleComplex(this, where)
	 	 end if
	}
Class:
	Module DoubleComplex (r as double=0, i as double=0, many=1&) {
		if many<1 then error "Wrong Dimension"
		buffer clear .k as double*2*many: .lim<=many-1
		return .k, 0:=r, 1:=i	
	}
}
Class FloatComplex as Complex{
Private:
	len=8
	Function newFloatComplex(a as FloatComplex, w) {
		buffer z as single*2
		return z, 0:=eval$(.k, w*.len!, .len)
		let a.k=z, a.lim=0
		=group(a) 
	}
	Function copyme(a as FloatComplex) {
		buffer z as single*2*(a.lim+1)
		return z, 0:=eval$(.k)
		let a.k=z
		=group(a) 
	}
Public:
	Operator "+"  {
		read a as Complex
		let this=.newFloatComplex(this, 0)
		return .k, 0:=eval(.k,0)+a.real, 1:=eval(.k, 1)+a.imaginary
	}
	Operator "-"  {
		read a as Complex
		let this=.newFloatComplex(this, 0)
		return .k, 0:=eval(.k,0)-a.real, 1:=eval(.k, 1)-a.imaginary
	}
	Set  () {
		read a as Complex
		read ? where=0&
		if where<0 or where>.lim then error "Index out of bound" else  where*=2
		if a  is type DoubleComplex then
			return .k, where:=a.real, where+1:=a.imaginary
		else.if a is type FloatComplex then
			return .k, where:=eval$(a.k)
		else
			error "can't assign this group"
		end if
	}
	Module Redim (many as long) {
		if many<1 then error "Wrong Dimension"
		buffer clear .k as single*2*many: .lim<=many-1
	}
	Module RedimPreserve (many as long) {
		if many<1 then error "Wrong Dimension"
		buffer .k as single*2*many: .lim<=many-1
	}
	Function final copy {
		=.copyme(this)
	}
	value (){
		read ? where=0&
		if where<0 or where>.lim then error "Index out of bound"
		if where=0 and .lim=0 then
			=this
		else
			=.newFloatComplex(this, where)
		end if
	}
Class:
	Module FloatComplex (r as single=0, i as single=0, many=1&) {
		if many<1 then error "Wrong Dimension"
		buffer clear .k as single*2*many: .lim<=many-1
		return .k, 0:=r, 1:=i
	}
}
def typename$(x)=type$(x) 
z1=FloatComplex(2,2) : print z1.toString$="(2+2i)"
z2=DoubleComplex(-2,3) :print  z2.toString$="(-2+3i)"
print typename$(z2.real)="Double"
z5=FloatComplex(10,-5) : print z5.toString$="(10-5i)"
print typename$(z5.real)="Single"
z5=FloatComplex(10) :print z5.toString$="(10)"
z6=DoubleComplex() : print z6.toString$="(0)"
z6=z5 :print z6.toString$="(10)"
print z5 is type FloatComplex = true
print z6 is type DoubleComplex = true
z2.imaginary++
z2.imaginary++
print  z2.toString$="(-2+5i)"
z5=z2
print typename$(z5.real)="Single"
print z5 is type FloatComplex = true
z5.real++
print z5.toString$="(-1+5i)"
zArray=FloatComplex(1,1,10)
zArray(4)=FloatComplex(30,-5)
zArray(5)=FloatComplex(3,-75)
zArray(7)=zArray(4)
for i=zArray.Lbound to zArray.Ubound
	print  i, zArray.toString$(i)
next
z5=zArray(4)
print z5.toString$="(30-5i)"
print zArray(4).toString$ = zArray.toString$(4)
print  z5.toString$="(30-5i)"
zk=z5+zArray+FloatComplex(5, 100)
print zArray(4).toString$="(30-5i)"
print zk.tostring$()="(36+96i)"
zk=zArray
// print zk.ubound, zk.ptr, zArray.ptr, zArray.Ubound
zA=zArray.Copy()  // copy 10 items
zArray(5)=FloatComplex(3, 4)
print zArray(5).toString$="(3+4i)"
print za(5).toString$="(3-75i)"
za(7)=zArray(5)+za(5)
print za(7).toString$="(6-71i)"
za(7)=za(7)-za(5)
print za(7).toString$="(3+4i)"
za(7)=za(7)-zArray(5)
print za(7).toString$="(0)"
z5.import z1.export$()
print z5.tostring$="(2+2i)"
zArray.import za.export$()
print zArray.toString$(7)="(0)"
print zArray.ptr<>za.ptr
print zArray.Ubound=9,  z5.Ubound=0
zArray.SwapBuffers &z5   // swap data only 
print zArray.Ubound=0, z5.Ubound=9, z5(5).toString$="(3-75i)"