Polymorphism: Difference between revisions

m (syntax highlighting fixup automation)
Line 1,574:
Works with any ANS Forth
 
Needs the FMS-SI (single inheritance) library code located here:
https://github.com/DouglasBHoffman/FMS2
http://soton.mpeforth.com/flag/fms/index.html
<syntaxhighlight lang="forth">include FMS-SIFMSVT.f
 
:class point
cell bytes x
ivar x \ instance variable
cell ivarbytes y
:m print x ? y ? ;m \ define print method
:m get ( -- x y ) x @ y @ ;m
:m put:init ( x y -- ) y ! x ! ;m
:m copy ( -- obj) self get heap> point-obj2 );m
;class
self get heap> point dup >r put r> ;m
;class
point p1 \ instantiate object p1
23 5 p1 put
p1 print
p1 copy value p2 \ copy constructor
p2 print
p2 <free \ destructor
.. p1.x ? \ print just x
.. p1.y ? \ print just y
8 .. p1.x ! \ change just x
9 .. p1.y ! \ change just y
 
23 5 p1 putpoint p
p1p print
p copy dup print <free
 
:class circle <super point
cell bytes r
point center \ re-use point class for instance variable
:m print super print r ? ;m
ivar radius
:m get ( -- x y r) super get r @ ;m
:m print center print radius ? ;m \ send print message to instance variable
:m get:init ( -- x y r --) r ! super :init ;m
:m copy ( -- centerobj) self get radiusheap> @circle ;m
:m put ( x y r -- )
radius ! center put ;m
:m copy ( -- circle-obj2 )
self get heap> circle dup >r put r> ;m
;class
circle c1
4 5 2 c1 put
c1 print
c1 copy value c2
c2 print
c2 <free
 
4 5 2 c1circle putc
.. c1.center print \ print just center
p2c print
.. c1.center.x ? \ print just x
c copy dup print <free </syntaxhighlight>
.. c1.center.y ? \ print just y
.. c1.radius ? \ print just radius
p1 get .. c1.center put \ change just center using a point
100 .. c1.radius ! \ change just radius </syntaxhighlight>
 
=={{header|Fortran}}==
4

edits