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