xref: /freebsd/stand/ficl/softwords/forml.fr (revision b0d29bc47dba79f6f38e67eabadfb4b32ffd9390)
1\ examples from FORML conference paper Nov 98
2\ sadler
3\
4\ $FreeBSD$
5
6.( loading FORML examples ) cr
7object --> sub c-example
8             cell: .cell0
9    c-4byte   obj: .nCells
10  4 c-4byte array: .quad
11       c-byte obj: .length
12         79 chars: .name
13
14    : init   ( inst class -- )
15        2dup  object => init
16        s" aardvark"  2swap  --> set-name
17    ;
18
19    : get-name  ( inst class -- c-addr u )
20        2dup
21        --> .name  -rot      ( c-addr inst class )
22        --> .length --> get
23    ;
24
25    : set-name  { c-addr u 2:this -- }
26        u       this --> .length --> set
27        c-addr  this --> .name  u move
28    ;
29
30    : ?  ( inst class ) c-example => get-name type cr ;
31end-class
32
33
34: test ." this is a test" cr ;
35' test
36c-word --> ref testref
37
38\ add a method to c-word...
39c-word --> get-wid ficl-set-current
40\ list dictionary thread
41: list  ( inst class )
42    begin
43        2dup --> get-name type cr
44        --> next over
45    0= until
46    2drop
47;
48set-current
49
50object subclass c-led
51    c-byte obj: .state
52
53    : on   { led# 2:this -- }
54        this --> .state --> get
55        1 led# lshift or dup !oreg
56        this --> .state --> set
57    ;
58
59    : off   { led# 2:this -- }
60        this --> .state --> get
61        1 led# lshift invert and dup !oreg
62        this --> .state --> set
63    ;
64
65end-class
66
67
68object subclass c-switch
69
70    : ?on   { bit# 2:this -- flag }
71
72        1 bit# lshift
73    ;
74end-class
75
76