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

marker --morse--


\ die Werte in der Flashtabelle sind immer 2 Byte groß
\ die Bits brauchen nicht mehr in 8 bits gepackt werden,
\ sondern lediglich in das niedrige|hoehere Byte
: pack   ( bits #bits -- x )   >< or  ;
: unpack ( x -- bits #bits )   dup $00ff and swap >< $00ff and ;

\ erstelle Tabelle im flash memory.
\ Werte sind 2 Bytes groß,
\ Index increments in 1 !

create mtable
0 ,                \    $60 offset
%00010  &2 pack ,  \ a  $61
%00001  &4 pack ,  \ b
%01010  &4 pack ,  \ c
%00001  &3 pack ,  \ d
%00000  &1 pack ,  \ e
%00100  &4 pack ,  \ f
%00011  &3 pack ,  \ g
%00000  &4 pack ,  \ h
%00000  &2 pack ,  \ i
%01110  &4 pack ,  \ j
%00101  &3 pack ,  \ k
%00010  &4 pack ,  \ l
%00011  &2 pack ,  \ m
%00001  &2 pack ,  \ n
%00111  &3 pack ,  \ o
%00110  &4 pack ,  \ p
%01101  &4 pack ,  \ q
%00010  &3 pack ,  \ r
%00000  &3 pack ,  \ s
%00001  &1 pack ,  \ t
%00001  &3 pack ,  \ u
%00001  &4 pack ,  \ v
%00011  &3 pack ,  \ w
%01001  &4 pack ,  \ x
%01011  &4 pack ,  \ y
%00011  &4 pack ,  \ z  $7a
0 ,
0 ,
0 ,
0 ,
0 ,
0 ,

variable o-emit

: domorse ( code #zeichen -- )
  \ Schleife Anzahl der Signale
  0 ?do
    \ Kopie anlegen
    dup
    \ erstes Bit maskieren
    1 and
    \ ist Bit gesetzt?
    if
      \ Strich
      lang
    else
      \ Punkt
      kurz
    then
    \ verbleibende Bits nach rechts schieben
    2/
  loop
  drop \ Argument loeschen
  Zend \ Pause Zeichenende
;

: morseemit ( key -- )
  \ altes emit ausfuehren
  dup o-emit @ execute
  \ Argument == Leerzeichen?
  dup bl = if
    Wend
  then
  \ Grosse [A-Z] -> kleine Zeichen [a-z]
  dup $40 > over $5b < and if
    $20 +
  then
  \ Argument auf [a-z] begrenzen
  dup  $60 >
  over $7b < and if
    \ index - TabellenOffset
    $60 -
    \ gepackten Wert holen
    mtable + @i
    \ entpacken
    unpack
    \ Signale ausgeben
    domorse
  else
    \ ungueltigen Code verwerfen
    drop
  then
; 

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

: init
  init \ init aus base.fs
  ['] emit defer@ o-emit !
;