1 CELLS CONSTANT CELL
: METHOD ( m v -- m' v ) CREATE  OVER , SWAP CELL+ SWAP
  DOES> ( ... o -- ... ) @ OVER @ + @ EXECUTE ;
: VAR ( m v size -- m v' ) CREATE  OVER , +
  DOES> ( o -- addr ) @ + ;
: CLASS ( class -- class methods vars ) DUP 2@ ;
: END-CLASS  ( class methods vars -- )
  CREATE  HERE >R , DUP , 2 CELLS ?DO ['] NOOP , CELL +LOOP
  CELL+ DUP CELL+ SWAP @ 2 - CELLS R> 2 CELLS + SWAP MOVE ;
: DEFINES ( xt class -- ) ' >BODY @ + ! ;
: NEW ( class -- o )  HERE OVER @ ALLOT SWAP OVER ! ;
: :: ( class "name" -- ) ' >BODY @ + @ COMPILE, ;
CREATE OBJECT  1 CELLS , 2 CELLS ,

Weitere Sourcen:

\ Usage:

OBJECT CLASS
  CELL VAR TEXT
  CELL VAR LEN
  CELL VAR X
  CELL VAR Y
  METHOD INIT
  METHOD DRAW
END-CLASS BUTTON

:NONAME ( o -- ) >R
 R@ X @ R@ Y @ AT-XY  R@ TEXT @ R> LEN @ TYPE ;
 BUTTON DEFINES DRAW
:NONAME ( addr u o -- ) >R
 0 R@ X ! 0 R@ Y ! R@ LEN ! R> TEXT ! ;
 BUTTON DEFINES INIT

\ interitance

: BOLD   27 EMIT ." [1m" ;
: NORMAL 27 EMIT ." [0m" ;

BUTTON CLASS END-CLASS BOLD-BUTTON
:NONAME BOLD [ BUTTON :: DRAW ] NORMAL ; BOLD-BUTTON DEFINES DRAW

\ Create and draw a button:

BUTTON NEW CONSTANT FOO
S" thin foo" FOO INIT
PAGE
FOO DRAW
BOLD-BUTTON NEW CONSTANT BAR
s" fat bar" BAR INIT
1 BAR Y !
BAR DRAW


Bernd Paysan
"Late answers are wrong answers!"
http://www.jwdt.com/~paysan/