section id="forth-objects"
rcsinfo="$Header: /home/radek/cvs/forth-book/sec-oop_ve_forthu.xml,v 1.3 2005/10/20 05:33:42 radek Exp $"
Podle http://c2.com/cgi/wiki?ForthObjects.
Kompletní implemetace HYPE, jednoduchého OOF s použitím ANSI standard Forth
: LIT, ( x ) POSTPONE LITERAL ;
: >SIZE ( ta - n ) CELL+ @ ;
0 VALUE SELF
: SELF+ ( n - a ) SELF + ;
: SEND ( a xt ) SELF >R SWAP TO SELF EXECUTE R> TO SELF ;
VARIABLE CLS ( contains ta )
: SIZE^ ( - aa ) CLS @ ?DUP 0= ABORT" scope?" CELL+ ;
: MFIND ( ta ca u - xt n ) 2>R BEGIN DUP WHILE DUP @ 2R@ ROT
SEARCH-WORDLIST ?DUP IF ROT DROP 2R> 2DROP EXIT THEN
CELL+ CELL+ @ REPEAT -1 ABORT" can't?" ;
: SEND' ( a ta "m " ) BL WORD COUNT MFIND 0< STATE @ AND
IF SWAP LIT, LIT, POSTPONE SEND ELSE SEND THEN ;
: SUPER ( "m " ) SIZE^ CELL+ @ BL WORD COUNT MFIND 0>
IF EXECUTE ELSE COMPILE, THEN ; IMMEDIATE
: DEFS ( n "f " ) CREATE SIZE^ @ , SIZE^ +! IMMEDIATE
DOES> @ STATE @ IF LIT, POSTPONE SELF+ ELSE SELF+ THEN ;
: METHODS ( ta ) DUP CLS ! @ DUP SET-CURRENT
>R GET-ORDER R> SWAP 1+ SET-ORDER ; ( ALSO CONTEXT ! )
: CLASS ( "c " ) CREATE HERE 0 , 0 , 0 ,
WORDLIST OVER ! METHODS ;
: SUBCLASS ( ta "c " ) CLASS SIZE^ OVER >SIZE OVER ! CELL+ ! ;
: END ( ) SIZE^ DROP PREVIOUS DEFINITIONS 0 CLS ! ;
: NEW ( ta "name " ) CREATE DUP , >SIZE ALLOT IMMEDIATE
DOES> DUP CELL+ SWAP @ SEND' ;Poznámky
Tento kód implementuje třídy a podtřídy s veřejnými metodami a proměnnými instancí.
Kód je jedním z nejjednoduších objektově orientovaných rozšíření Forthu který je přiměřeně použitelný. Kód není nejpěknější, ale je standardní, kompaktní a přiměřeně dobře faktorizovaný.
HYPE je celé napsáno jen velikými písmeny. Toto je vyžadováno přísnou kompatibilitou z ANSI Forth.
HYPE se přeloží do měně než 2K kódu na většině Forthů. Na některých platformách to bude méně než 500 bajtů.
S použitím uvedeného kódu můžeme psát:
: VAR 1 CELLS DEFS ; \ Helper for creating instance vars
CLASS BUTTON
VAR TEXT
VAR LEN
VAR X
VAR Y
: DRAW ( )
X @ Y @ AT-XY \ Get X and Y, and position cursor on screen
TEXT @ LEN @ TYPE ; \ Get TEXT and LENgth, and type it
: INIT ( ca u ) 0 X ! 0 Y ! LEN ! TEXT ! ;
END
: BOLD 27 EMIT ." [1m" ; \ Emit code to turn on BOLD TEXT
: NORMAL 27 EMIT ." [0m" ; \ Emit code to return to normal text
BUTTON SUBCLASS BOLD-BUTTON
: DRAW ( ) BOLD SUPER DRAW NORMAL ;
ENDDefinované třídy můžeme použít
BUTTON NEW FOO \ creates new button "FOO" S" thin foo" FOO INIT \ calls init method on FOO with string arg. PAGE \ clear the screen FOO DRAW \ draw FOO BOLD-BUTTON NEW BAR \ create new bold-button S" fat bar" BAR INIT \ initialize 1 BAR Y ! \ change the Y instance variable BAR DRAW \ draw the BAR button