stand/ficl/softwords/forml.fr

   1 \ examples from FORML conference paper Nov 98
   2 \ sadler
   3 \
   4
   5 .( loading FORML examples ) cr
   6 object --> 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 ;
  30 end-class
  31
  32
  33 : test ." this is a test" cr ;
  34 ' test
  35 c-word --> ref testref
  36
  37 \ add a method to c-word...
  38 c-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 ;
  47 set-current
  48
  49 object 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
  64 end-class
  65
  66
  67 object subclass c-switch
  68
  69     : ?on   { bit# 2:this -- flag }
  70
  71         1 bit# lshift
  72     ;
  73 end-class
  74