Эмуляция объектов. Продолжение

https://bitbucket.org/lulinalex/mindstream/src/4b88047f2ed8f34f73bfc7f9dfb45536132486ca/Examples/Scripts/Point/Point81.ms.script?at=B283

USES
 NoCapsLock.ms.dict
 params.ms.dict
 integer.ms.dict
;

//REDEFINITION
 : (-)
  IN aLeft
  right aRight
  ( aLeft (-) ( aRight DO ) )
 ; // 

Test PointTest

// Понятное дело, что всю обвязку потом упрячем в отдельный словарь object.ms.dict

VOID IMMEDIATE OPERATOR class_impl
; // class_impl

//VOID IMMEDIATE OPERATOR class_impl
//// - имплементация класса, пока "фиктивная"
// Literal IN aName
// @SELF Ctx:SetWordProducerForCompiledClass
// ':' Ctx:Parser:PushSymbol
// aName |N Ctx:Parser:PushSymbol
// //';' Ctx:Parser:PushSymbol
//; // class_imp

STRING var g_CurrentClass
g_CurrentClass := ''
STRING var g_CurrentClassImpl
g_CurrentClassImpl := ''

VOID IMMEDIATE OPERATOR class
 Literal IN aName
 aName |N >>> g_CurrentClass
 //'class_impl' Ctx:Parser:PushSymbol
 // - вообще должно быть так, почему не работает - надо разбираться
 ':' Ctx:Parser:PushSymbol
 @ class_impl Ctx:SetWordProducerForCompiledClass
 [ '_:' g_CurrentClass ] strings:Cat >>> g_CurrentClassImpl
 g_CurrentClassImpl Ctx:Parser:PushSymbol
 ';' Ctx:Parser:PushSymbol

 'array' Ctx:Parser:PushSymbol
 'type' Ctx:Parser:PushSymbol
 g_CurrentClass Ctx:Parser:PushSymbol

; // class

INTEGER type FieldOffset
// - смещение поля

IMMEDIATE VOID operator constructor
// - конструктор объектов, пока "фиктивный"
 Literal IN aName
 @SELF Ctx:SetWordProducerForCompiledClass
 g_CurrentClass Ctx:Parser:PushSymbol
 ':' Ctx:Parser:PushSymbol
 [ g_CurrentClass ':' aName |N ] strings:Cat Ctx:Parser:PushSymbol
; // constructor

PRIVATE VOID operator MakeMethodSignature
 STRING IN aName
 ':' Ctx:Parser:PushSymbol
 [ g_CurrentClass ':' aName ] strings:Cat Ctx:Parser:PushSymbol
; // MakeMethodSignature

PRIVATE VOID operator MakeSelfParam
 g_CurrentClass Ctx:Parser:PushSymbol
 'in' Ctx:Parser:PushSymbol
 'Self' Ctx:Parser:PushSymbol
; // MakeSelfParam

IMMEDIATE VOID operator method
// - метод объекта, пока "фиктивный"
 Literal IN aName
 @SELF Ctx:SetWordProducerForCompiledClass
 aName |N MakeMethodSignature
 MakeSelfParam
; // method

IMMEDIATE VOID operator readonly
// - read-only свойство объекта, пока "фиктивное"
 Literal IN aName
 @SELF Ctx:SetWordProducerForCompiledClass
 aName |N MakeMethodSignature
 MakeSelfParam
; // readonly

IMMEDIATE VOID operator new[
 '[' Ctx:Parser:PushSymbol
 '@' Ctx:Parser:PushSymbol
 g_CurrentClassImpl Ctx:Parser:PushSymbol
; // new[

INTEGER VAR g_ClassFieldOffset
[EXECUTE]
( g_ClassFieldOffset := 0 )
g_ClassFieldOffset := 0

IMMEDIATE VOID operator member
 Literal IN aName
 'private' Ctx:Parser:PushSymbol
 'Const' Ctx:Parser:PushSymbol
 [ 'c:' g_CurrentClass ':Offset:' aName |N ] strings:Cat Ctx:Parser:PushSymbol
 g_ClassFieldOffset Ctx:Parser:PushInt
 Inc g_ClassFieldOffset
; // member

IMMEDIATE VOID operator members-end
 'private' Ctx:Parser:PushSymbol
 'Const' Ctx:Parser:PushSymbol
 [ 'c:' g_CurrentClass ':Instance:Size' ] strings:Cat Ctx:Parser:PushSymbol
 g_ClassFieldOffset Ctx:Parser:PushInt
; // members-end

class Object

: FieldByOffset
 Object in Self
 FieldOffset right anOffset
 anOffset |^ Self [i]
; // FieldByOffset

PRIVATE operator do-get-member
 STRING IN aName
 'FieldByOffset' Ctx:Parser:PushSymbol
 [ 'c:' g_CurrentClass ':Offset:' aName ] strings:Cat Ctx:Parser:PushSymbol 
; // do-get-member

VOID IMMEDIATE operator get-member
 Literal IN aName
 aName |N do-get-member
; // get-member

VOID IMMEDIATE operator read
 Literal IN aName
 'Self' Ctx:Parser:PushSymbol 
 aName |N do-get-member
 '>>>' Ctx:Parser:PushSymbol 
 'Result' Ctx:Parser:PushSymbol
 ';' Ctx:Parser:PushSymbol
; // read

member VMT
members-end

TtfwWord readonly class read VMT

STRING readonly ClassName
 Self Object:class |N ':' string:Split >>> Result DROP
; // Object:ClassName

INTEGER type Pixel
// - пиксель
List type PixelList
// - список пикселей

class Point

member X
member Y
members-end

constructor :
 Pixel right aX
 Pixel right aY
 new[ aX |^ aY |^ ] >>> Result
; // :

constructor 0
 Point:: 0 0 >>> Result
; // 0

constructor XY
 PixelList right aPoint
 array var Points
 [ aPoint |^ ] >>> Points
 Point:: ( Points FieldByOffset 0 ) ( Points FieldByOffset 1 ) >>> Result
; // XY

Pixel readonly X read X

Pixel readonly Y read Y

constructor OF
 Point right aPoint
 Point:: ( aPoint |^ Point:X ) ( aPoint |^ Point:Y ) >>> Result
; // OF

Point method +
 Point right aPoint

 Point:: ( Self Point:X (+) ( aPoint |^ Point:X ) ) ( Self Point:Y (+) ( aPoint |^ Point:Y ) ) >>> Result
; // +

Point method Neg
 Point:: Neg ( Self Point:X ) Neg ( Self Point:Y ) >>> Result
; // Neg

Point method -
 Point right aPoint

 Point:OF ( Self Point:+ ( aPoint |^ Point:Neg ) ) >>> Result
; // -

void method Print
 [ '( ' 'X: ' Self Point:X ToPrintable ', Y: ' Self Point:Y ToPrintable ' )' ] strings:Cat Print
; // Print

Point var P1
Point var P2
Point var P3
Point var P4
Point var P5
Point var P6
Point var P7
Point var P8
Point var P9
Point var P10

P1 := Point:0
P2 := Point:0
P3 := Point:: 1 1
P4 := Point:XY ( 2 2 )
P5 := Point:OF P4
P6 := ( P3 Point:+ P4 )
P7 := ( P3 Point:- P4 )
P8 := ( P4 Point:- P3 )
P9 := ( P4 Point:Neg )
P10 := ( P3 Point:Neg )

Object var O1
O1 := P1
O1 Point:Print

array var l_Points

[ P1 P2 P3 P4 P5 P6 P7 P8 P9 P10 ] >>> l_Points

for l_Points Point:Print
for l_Points ( Point:X Print )
for l_Points ( Point:Y Print )
for l_Points ( Object:class Print )
for l_Points ( Object:ClassName Print )

'Hello ' (+) 'world' Print

'Hello ' (+) 'world' Print

'Hello ' (+) 'world' Print

1 (+) 2 Print
10 (+) 20 Print
0 (-) 10 Print
Neg 10 Print
Neg -10 Print

USES
 CodeDump.ms.dict
;

@SELF DumpElement

; // PointTest

PointTest