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

marker --morse--

\ erstelle Tabelle fuer gepackte Morse-Daten
variable mtable 256 allot

\ loesche Tabelle
mtable 256 erase

\ Hilfswort zum Fuellen der Tabelle
: >mtable ( gepackter-morsecode c -- )
  mtable + c!
;

\ Hilfsworte zum Ent-/Packen von Morse-Codes
: pack ( #zeichen code -- pcode )
  3 lshift swap 7 and or
;
: unpack ( pcode -- #zeichen code )
  dup 7 and swap 3 rshift 
;

\ Zahlenbasis auf "2" setzen
: binary  2 base ! ;

\ Tabelle zur Kompilierzeit fuellen
binary 00010  decimal 2 pack  char a >mtable
binary 00001  decimal 4 pack  char b >mtable
binary 01010  decimal 4 pack  char c >mtable
binary 00001  decimal 3 pack  char d >mtable
binary 00000  decimal 1 pack  char e >mtable
binary 00100  decimal 4 pack  char f >mtable
binary 00011  decimal 3 pack  char g >mtable
binary 00000  decimal 4 pack  char h >mtable
binary 00000  decimal 2 pack  char i >mtable
binary 01110  decimal 4 pack  char j >mtable
binary 00101  decimal 3 pack  char k >mtable
binary 00010  decimal 4 pack  char l >mtable
binary 00011  decimal 2 pack  char m >mtable
binary 00001  decimal 2 pack  char n >mtable
binary 00111  decimal 3 pack  char o >mtable
binary 00110  decimal 4 pack  char p >mtable
binary 01101  decimal 4 pack  char q >mtable
binary 00010  decimal 3 pack  char r >mtable
binary 00000  decimal 3 pack  char s >mtable
binary 00001  decimal 1 pack  char t >mtable
binary 00001  decimal 3 pack  char u >mtable
binary 00001  decimal 4 pack  char v >mtable
binary 00011  decimal 3 pack  char w >mtable
binary 01001  decimal 4 pack  char x >mtable
binary 01011  decimal 4 pack  char y >mtable
binary 00011  decimal 4 pack  char z >mtable

variable o-emit

: domorse ( code #zeichen -- )
  \ Schleife Anzahl der Signale
  0 ?do
    dup           \ Kopie anlegen
    1 and         \ erstes Bit maskieren
    if            \ ist Bit gesetzt? dann
      lang        \   Strich
    else          \ sonst
      kurz        \   Punkt
    then          \
    \ verbleibende Bits nach rechts schieben
    2/
  loop
  drop            \ Argument loeschen
  Zend            \ Pause Zeichenende
;
: morseemit ( key -- )
  \ altes emit ausfuehren
  dup o-emit @ execute
  \ Argument auf 0-255 begrenzen
  255 and
  dup bl = if     \ Leerzeichen? dann
    Wend          \   Pause Wortende
  then

  mtable + c@     \ Morse-Code holen
  unpack          \ entpacken
  domorse         \ Signale ausgeben
;

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