\ --- morse/morse2.fs -----------------------
\ 2011-10-26  EW
\ 2011-11-02  CS
\ arduino duemilanove + danger shield
\ morse code stuff
\ (Potsdam/Augsburg/Oberhausen)
\ 2nd version

marker --morse--

: _A  kurz lang Zend ;
: _B  lang kurz kurz kurz Zend ;
: _C  lang kurz lang kurz Zend ;
: _D  lang kurz kurz      Zend ;
: _E  kurz                Zend ;
: _F  kurz kurz lang kurz Zend ;
: _G  lang lang kurz      Zend ;
: _H  kurz kurz kurz kurz Zend ;
: _I  kurz kurz           Zend ;
: _J  kurz lang lang lang Zend ;
: _K  lang kurz lang      Zend ;
: _L  kurz lang kurz kurz Zend ;
: _M  lang lang           Zend ;
: _N  lang kurz           Zend ;
: _O  lang lang lang      Zend ;
: _P  kurz lang lang kurz Zend ;
: _Q  lang lang kurz lang Zend ;
: _R  kurz lang kurz      Zend ;
: _S  kurz kurz kurz      Zend ;
: _T  lang                Zend ;
: _U  kurz kurz lang      Zend ;
: _V  kurz kurz kurz lang Zend ;
: _W  kurz lang lang      Zend ;
: _X  lang kurz kurz lang Zend ;
: _Y  lang kurz lang lang Zend ;
: _Z  lang lang kurz kurz Zend ;

\ erstelle Tabelle fuer execution token
variable mtable 256 2 * allot

\ loesche Tabelle
mtable 256 2 * erase

\ Hilfswort zum Fuellen der Tabelle
: >mtable ( xt c -- )
  2 * mtable + !
;

\ Tabelle zur Kompilier-Zeit fuellen
' _A  char a >mtable
' _B  char b >mtable
' _C  char c >mtable
' _D  char d >mtable
' _E  char e >mtable
' _F  char f >mtable
' _G  char g >mtable
' _H  char h >mtable
' _I  char i >mtable
' _J  char j >mtable
' _K  char k >mtable
' _L  char l >mtable
' _M  char m >mtable
' _N  char n >mtable
' _O  char o >mtable
' _P  char p >mtable
' _Q  char q >mtable
' _R  char r >mtable
' _S  char s >mtable
' _T  char t >mtable
' _U  char u >mtable
' _V  char v >mtable
' _W  char w >mtable
' _X  char x >mtable
' _Y  char y >mtable
' _Z  char z >mtable
' Wend    bl >mtable

: SOS _S _O _S  Wend ;

variable o-emit

: morseemit ( key -- )
  \ altes emit ausfuehren
  dup o-emit @ execute
  \ Argument auf 0-255 begrenzen
  255 and
  \ XT aus Tabelle lesen
  2 * mtable + @
  \ XT > 0 ?
  dup if
    \ ausfuehren
    execute
  else
    \ sonst wegwerfen
    drop
  then
;

: morse
  ['] emit defer@ o-emit !
  ['] morseemit is emit
;
: endmorse
  o-emit @ is emit 
;