Programmierbeispiele

Diese Beispiele sind in 4e4th05a „For Education Forth“ auf dem TI LaunchPad erstellt und ausprobiert worden.

Benutze das vollständige Glossar zum 4e4th (PDF) um dich zu orientieren.

Wenn du mit Forth noch nicht vertraut bist, mache die Übungen aus der Online Edition des Starting Forth von Leo Brodie. Das komplette Buch kann auch als PDF runtergeladen werden von http://www.exemark.com/FORTH.htm Und ist damit lokal speicherbar und zum Ausdrucken geeignet.

Dort heißt es: „Code examples run on iForth and SwiftForth“. Keine Sorge, alle Übungen sind ANS Forth, und 4e4th ist ein ANS Forth. Doch es gibt auch Einschränkungen. Denn 4e4th läuft auf einer kleinen MCU und nicht auf einem PC. Es kommt mit 1K RAM und 8K user flash aus. Und ist selbst nur 8K groß.

Die Einschränkungen sind:
Ein Zelle (CELL) ist 16 bit breit.
-1 HEX U. FFFF ok

Der integer Zahlenumfang ist daher
HEX 7FFF DECIMAL . 32767 ok
HEX 8000 DECIMAL . -32768 ok

Viel Vergnügen.

DECIMAL
: blink ( -- )  
    BEGIN 
      red csetb green cclrb 100 MS
      red cclrb green csetb 100 MS
    KEY? UNTIL KEY DROP ;
    

Das Forth Wort MS nimmt eine Zahl vom Stack. Es ist eine einfache leere Schleife. 1000 MS ergeben ungefähr eine Sekunde.

Voltmeter in DCV Einstellung bringen um Gleichspannung zu messen. Schwarze Messleitung an Masse (GND) und Rote an den gewünschten Portpin anschießen. Schaltung: Portpinx ←—-Voltmeter auf DCV—-GND

Das Voltmeter integriert den Pegel über die Zeit. Eine rasche Pulsfolge wird daher in eine entsprechende Spannung umgesetzt. Pulse im Tastverhältniss 50/50 ergeben die halbe Portspannung. Bei einem Pegel von high=3,54V an den Pins ergibt das 1,77V. Probiere verschiedene Teiler aus! Welche pins sind hier aktiv?

VARIABLE teiler    100 teiler !

: teile  ( -- )
  16 P1 cset 32 P1 cclr
  BEGIN
    48 P1 ctoggle
    100 teiler @ / DROP 1 MS  ( siehe * )
    48 P1 ctoggle
    100 teiler @ / MS
  KEY? UNTIL key drop
;  ( Fritz )

Schalter S2 ist an Port1 angeschlossen.

P1.3 --->---o_o--- GND

Das Forth Wort S2? liefert seinen Zustand auf den Stack. Mit diesem kleinen Test kannst du überprüfen ob der Schalter funktioniert.

: s2test ( -- ) BEGIN S2? . KEY? UNTIL ;

Die Phrase KEY? UNTIL in der BEGIN UNTIL Schleife sorgt dafür das du den Test auch wieder verlassen kannst.

Ich hatte ein LaunchPad auf dem S2 defekt war! Und mich lange gewundert warum all meine Programmversuche fehl schlugen. Verwende ein Voltmeter oder Oscilloskop um deine Eingabe an S2 zu überprüfen falls was nicht so wie erwartet geht.

S2? testet das Bit 3 vom Port1 ohne die anderen Bits zu beeinflussen.

Erste Umsetzung des amForth Morse-Programmes, Version 1 (naive Implementierung).

MARKER --base--

: blink ( cycles -- ) 
  red cset 
  0 DO 
    3 MS 
  LOOP 
  red cclr ;

: gap ( cycles -- )
  0 DO 
    2 MS 
  LOOP ;

: kurz 50 blink 50 gap ; ( kurzes Signal )
: lang 150 blink 50 gap ; ( langes Signal )

: Zend   100 gap ; ( Zeichenende )
: Wend   300 gap ; ( Wortende )

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 ;

: SOS _S _O _S ;

Eine Version, die Töne macht, ist auch nicht schwer. morsen2.rtf.zip

So ein einfache Schaltung mit einem kleinen 8 Ohm 0,2 Watt Lautschrecher reicht dazu schon:

    
 Schaltung:   P1.4 --->------Lautsprecher-----<---P1.5 
 

Damit kann man schon recht schön morsen. Man hört das „did did dah“ und sieht die LED dazu blinken.

Beispiel für die TI MSP430G2553 MCU.

hex 
0120 Constant WDTCTL
: wdt! ( val -- )   5A00 ( password ) or WDTCTL ! ;
: +wdt ( -- )  08 wdt! ;
: -wdt ( -- )  80 wdt! ;
decimal 
: wdt-test ( n -- ) 1 DO  I  DUP . +wdt  0 DO LOOP -wdt LOOP   ." done"  ;
save

Der wdt-test zählt bis ca. 2700 und macht dann einen Watchdog-Reset, was man am Bit 0 von COR (cause of reset) sehen kann.

BIN COR @ . DECIMAL

Der COR Wert wird auch am Ende der Satrtmeldung angezeigt. Die Einsen und Nullen rechts vom senkrechten Strich sind der COR Wert, binär dargestellt.

Der Wert in COR ist eine Kopie des IFR1 der MCU (interupt flag register1), siehe User Manual.

Eine Implementierung von Conway's Game of Life, optimiert für Mikrocontroller. Eignet sich um kleine Bitmap-Animationen zu generieren um Muster auf ein Display zu zaubern. Das aktuelle Muster steht immer in PAD, eine Zelle pro Zeile, 16 Zeilen hintereinander, also 16×16 bits = 32 bytes. Das Muster wird mit NEXTGEN auf die nächste Generation aktualisiert. Einen temporären Puffer gibt es nicht, lediglich die letzten 2 Zeilen des alten Musters werden während des Updates auf dem Stack gehalten. Geometrie des Universums entspricht einem Torus, links/rechts, oben/unten gehen jeweils ineinander über. Eingabe von LIFE startet eine kontinierliche Animation ins Terminal, Abbruch mit <q>. Vordefinierte Muster können mit VOID GLIDER, VOID LWSS etc. geladen werden

DECIMAL
16 CONSTANT #lines
PAD CONSTANT universe
8 CELLS CONSTANT bits/cell  \ = number of columns

: line  ( n -- a-addr ) CELLS universe + ;
: lrot  ( x1 -- x2 )  \ rotate left by one
   DUP 2* SWAP 0< - ;
: lrot3  ( x1 x2 x3 --  x4 x5 x6 )
   lrot ROT  lrot ROT  lrot ROT ;

IHERE  0 IC, 1 IC, 1 IC, 2 IC,  1 IC, 2 IC, 2 IC, 3 IC,  CONSTANT #bits
: countbits  ( x -- n )  \ count number of bits=1 in bit0..2
   7 AND #bits + C@ ;

: alive  ( x1 x2 x3 -- flag )
   \ return whether cell at bit1 in line1 is alive in next generation
   OVER 2 AND 0= INVERT >R
   countbits
   SWAP countbits +  \ note: cell itself is counted, too. correction below.
   SWAP countbits +
   DUP 3 =  SWAP 4 = R> AND OR ;
: 3dup  ( x1 x2 x3 -- x1 x2 x3 x1 x2 x3 )
   DUP 2OVER ROT ;
: doline  ( x1 x2 x3 -- x1 x2 x3 x4 )
   0  bits/cell 0 DO 
      >R   3dup alive 2 AND R> OR lrot >R
      lrot3   R>
   LOOP ;
: nextgen  ( -- )
   0 line @   #lines 1- line @  OVER   ( s: line0   x1 x2 )
   #lines 1- 0 DO
      I 1+ line @               ( s: line0  x1 x2 x3 )
      doline  I line !
      ROT DROP                  ( s: line0  x2 x3 )
   LOOP  
   ROT doline  #lines 1- line !   \ special treatment for last line
   2DROP DROP ;
: .line  ( x -- )
   bits/cell 0 DO
      DUP 0< IF [char] @  ELSE [char] . THEN EMIT
      lrot
   LOOP  DROP ;
: .universe  ( -- )  \ print current life state to console 
   #lines 0 DO   CR I line @ .line  LOOP ;
: life  ( -- ) \ run life with output to console, until key <q> pressed
   BEGIN
      PAGE .universe     nextgen  20 MS 
   KEY? IF KEY [char] q = ELSE 0 THEN UNTIL ;

: void  ( -- )  universe #lines CELLS 0 FILL ;
: seed  ( x1 .. xn n -- )   0 DO i line ! LOOP ;
HEX   \ some wellknown patterns:
: glider  ( -- )  7 1 2  3 seed ;
: fpent  ( -- )  4 0C 6  3 seed ;
: lwss  ( -- )  0F 11 1 12  4 seed ;
: diehard  47 0C0 2  3 seed ;
: acorn  67 8 20  3 seed ;
: demo   glider   700 3 line ! ;
DECIMAL

void demo life  \ Start der Animation, Abbruch mit <q>

Ein kleiner Disassembler für den MSP430 um Codestückchen prüfen zu können.

\ Albert Nijhof, Willem Ouwerkerk
\ an    -- 05mei12 -- 430 disassembler
\ wo    -- 09mei12 -- working on Launchpad about 1,2 kByte
\ wo    -- 12mei12 -- Debugged version, working ok, still about 1,2 kByte
\ an&wo -- 13mei12 -- Tested, 1,1 kbytes!
\ wo    -- 14mei12 -- Print real address with jumping & keep das save

\ The disassembler output corresponds with our assembler notation:
\ MSP assembly     disassembles to
\ ------------     ------------      --------------
\ PC R8            pc r8             Register names
\ PC@              pc )              Indirect addressing
\ PC@+             pc )+             Indirect with autoincrement
\ 430              xx pc i)          xx + pc = 430 (Symbolic mode)
\ 2(R8)            2 r8 i)           Indexed
\ #430             430 #             constant 430 assembled as pc )+
\ &430             430 &             Absolute using SR
\ #4 #8            #4 #8             Constants using RS
\ #0 #1 #2 #-1     #0 #1 #2 #-1      Constants using CG

\ pc-relative jmp  goto +3           Always jump 3 words forward
\ pc-relative jnc  jcc -4            On carry clear jump 4 words backward

hex  \ until the end
: 4.r   0 <# # # # # #> type ;
: i"    [char] " word count rot swap d->i ;
: icreate <builds does> ;

hex
icreate one-ops  8 4 * iallot
   one-ops i" RRC SWPBRRA SXT PUSHCALLRETI7?  "
icreate jumpings 8 4 * iallot
   jumpings i" J0<>J0= JCC JCS J0< J>= J<  GOTO"
icreate two-ops 8 2* 4 * iallot
   two-ops i" 0?  1?  2?  3?  MOV ADD ADDCSUBC"
   two-ops 20 + i" SUB CMP DADDBIT BIC BIS XOR AND "
icreate regs 8 2* 3 * iallot
   regs i" pc rp sr cg sp ip w  tosr8 r9 r10r11r12r13r14r15"

variable dasadr  ihere dasadr !
: dasadr@+ ( -- dascode )    dasadr @ @  2 dasadr +! ;
: .reg ( nr -- ) 3 * regs +   dup 2 + c@ bl = 3 + type space ;

: .dst ( a r -- )
  over 1 = if dasadr@+ .  dup 2 = if  2drop ." & " exit then then
  .reg
  dup 1 = if ." i" then
  dup     if ." )" then
  dup 3 = if ." +" then
  if space then ;

: .src ( a reg -- )
  dup 3 = if drop dup 3 = if 4 - then  ." #" . exit then      \ cg #-1 #0 #1 #2
  over 2 and over 2 = and if ." #" 1- swap lshift . exit then \ sr #4 #8
  over 3 = over 0= and if 2drop dasadr@+ u. ." # " exit then  .dst ;

: b/w     ( dascode -- )  40 and if ." .b " then ;
: .mnemo  ( +n adr -- )   swap 2* 2* + 4 type space ;

: one-op ( dascode 1 )   drop >r
  r@ ( dascode )  7 rshift 7 and   dup 6 <>  \ not reti?
  if    r@ 4 rshift 3 and   r@ 0f and .src   r@ b/w
  then  r> drop  one-ops .mnemo ;

: two-op ( dascode 4..F )   swap
  ( src a,r ) dup 4 rshift 3 and   over 8 rshift 0F and   .src
  ( dst a,r ) dup 7 rshift 1 and   over          0F and   .dst  b/w
  ( mnemo )   two-ops .mnemo ;

: jumping ( dascode 2..3 )   drop
  ( mnemo )    dup 0A rshift 7 and   jumpings .mnemo
  ( distance ) 03FF and 0200 over and    \ Negative?
   if FC00 or then 2*  dasadr @ +  4.r space ;  \ Calculate real address

\ Decode 1 instruction, addr has to be in dasadr
: das+ ( -- ) \ disassemble next instruction
   cr dasadr @ 4.r ." :" space  \ Print address
   dasadr@+   dup 4.r space space  \ Print opcode
   dup 0C rshift    ( dascode  n )
   dup 0=  if 2drop ." ?" exit then  \ Invalid opcode
   dup 1 = if ( dascode 1 )    one-op exit then
   dup 4 < if ( dascode 2..3 ) jumping exit then
              ( dascode 4..F ) two-op ;

\ ----- User words
: cdas ( -- )     base @ >r hex  begin  das+  key bl <> until  r> base ! ;
: mdas ( adr -- ) dasadr !  cdas ;
: das  ( ccc -- ) ' dup @  over cell+ = if  cell+ mdas exit then  drop ;

: keep ( -- )  50 ms  green cclr 50 ms red cclr ;  \ leds off
' keep app !  save  \ Remember disassembler

decimal
\ End

Das 8×8 LED-Matrix Display aus Ausgabe 1993-1 der Vierten Dimension geht auch am Launchpad. Dank an Rolf Kretzschmar, der Display und Kabel zur Verfügung stellte. Die Verdrahtung ist wie folg:

Damit das MODE-Signal auf dem Flachbandkabel, Pin 2 landet, muss auf der Rückseite des Boards eine kleine Lötbrücke gesetzt werden.
Zusätzliche Infos, siehe auch die Dokumentation zum Treiber—IC ICM7218.

\ Everything below is in HEX!!!
HEX

22 CONSTANT p1dir
2A CONSTANT p2dir

: databus!  ( x -- ) \ set data lines i0..i7
   60 P1 CCLR  3F P2 CCLR    \ clear P1.5,P1.6, P2.0..P2.5
   DUP 1 RSHIFT 3F AND P2 CSET   \ set bits I1..I6 as P2.0..P2.5
   DUP 1 AND 5 LSHIFT
   SWAP 80 AND 1 RSHIFT OR P1 CSET ;  \ set bits I0,I7 as P1.5,P1.6
: write  ( -- ) \ pull write signal low one cycle
   80 P1 2DUP CTOGGLE  CTOGGLE ;  \ toggle P1.7=WRITE
: data!  ( x -- ) \ data write
   databus!  write ;
: pixels! ( x -- )  \ when writing raw LED pixel data, ICM7218A inverts bit7!
   80 XOR data! ;
: ctrl!  ( x -- ) \ write control byte (i.e. write with mode=high)
   10 P1 2DUP CTOGGLE   \ toggle P1.4=MODE
   ROT data!  CTOGGLE ;

: ledinit  ( -- )  \ initialize LED pins
   80 P1 CSET  10 P1 CCLR  \ inactive state is WRITE=1 MODE=0
   0F0 p1dir CSET  3F p2dir CSET ;  \ P1.4..P1.7, P2.0..P2.5 as output

: framestart  ( -- ) \ start transmission of new frame,
   \ LEDs stay off, until 8 new data-bytes transferred!
   0F0 ctrl! ;
: bounds  ( c-addr1 n  -- c-addr2 c-addr1 )  OVER + SWAP ;
: frame  ( c-addr -- )  \ write 8 bytes starting at c-addr to LED
   \ note: inverting bit8, as ICM7218 treats that specially
   framestart  8 bounds DO I C@ pixels! LOOP ;
: pattern  ( x -- )  PAD 8 ROT FILL  PAD frame ;

Um Conways Game of Life (Beispile weiter oben) auf das Display zu bekommen, braucht man zusätzlich noch folgende Zeilen:

HEX
: display  ( -- )  \ write (part of) Life universe to display
   framestart 0A 2 DO I line @ 8 RSHIFT pixels! LOOP ;
: ledlife  ( -- ) \ run life with output to LED display until key <q> pressed
   BEGIN
      display     nextgen  80 MS 
   KEY? IF KEY [char] q = ELSE 0 THEN UNTIL ;

Dieser Font kostet etwa 1.5kB Flash und liefert 8×8 Bitmap Daten für alle ASCII und Latin-1 Zeichen (also inklusive Umlaute etc.). Das Wort GLYPH gibt einen Zeiger auf die Daten eines Zeichens. Jedes Zeichen hat 8 Bytes, jedes Byte ist dabei eine Zeile, Reihenfolge oben nach unten, Bit7 ist der linke, Bit0 der rechte Rand.

\ Actual font data taken from Allegro 4 (alleg.sf.net), copyright (c) the
\ allegro authors, License: gift-ware.
\
\ This font occupies 1.5 k of flash memory.  You may want to remove the
\ latin-1 part and only keep the ASCII half to strip it down to 768 bytes.
HEX 

: glyph,  ( "num"x8 -- )  \ avoid searching dictionary when parsing data below
   8 0 DO 0 0 BL WORD COUNT >NUMBER 2DROP DROP IC, LOOP ;

IHERE  ( s: font-addr)
glyph, 00 00 00 00 00 00 00 00  \ char 0x20
glyph, 18 3C 3C 18 18 00 18 00
glyph, 6C 6C 6C 00 00 00 00 00
glyph, 6C 6C FE 6C FE 6C 6C 00
glyph, 18 7E C0 7C 06 FC 18 00
glyph, 00 C6 CC 18 30 66 C6 00
glyph, 38 6C 38 76 DC CC 76 00
glyph, 30 30 60 00 00 00 00 00
glyph, 18 30 60 60 60 30 18 00
glyph, 60 30 18 18 18 30 60 00
glyph, 00 66 3C FF 3C 66 00 00
glyph, 00 18 18 7E 18 18 00 00
glyph, 00 00 00 00 00 18 18 30
glyph, 00 00 00 7E 00 00 00 00
glyph, 00 00 00 00 00 18 18 00
glyph, 06 0C 18 30 60 C0 80 00
glyph, 7C CE DE F6 E6 C6 7C 00
glyph, 30 70 30 30 30 30 FC 00
glyph, 78 CC 0C 38 60 CC FC 00
glyph, 78 CC 0C 38 0C CC 78 00
glyph, 1C 3C 6C CC FE 0C 1E 00
glyph, FC C0 F8 0C 0C CC 78 00
glyph, 38 60 C0 F8 CC CC 78 00
glyph, FC CC 0C 18 30 30 30 00
glyph, 78 CC CC 78 CC CC 78 00
glyph, 78 CC CC 7C 0C 18 70 00
glyph, 00 18 18 00 00 18 18 00
glyph, 00 18 18 00 00 18 18 30
glyph, 18 30 60 C0 60 30 18 00
glyph, 00 00 7E 00 7E 00 00 00
glyph, 60 30 18 0C 18 30 60 00
glyph, 3C 66 0C 18 18 00 18 00
glyph, 7C C6 DE DE DC C0 7C 00
glyph, 30 78 CC CC FC CC CC 00
glyph, FC 66 66 7C 66 66 FC 00
glyph, 3C 66 C0 C0 C0 66 3C 00
glyph, F8 6C 66 66 66 6C F8 00
glyph, FE 62 68 78 68 62 FE 00
glyph, FE 62 68 78 68 60 F0 00
glyph, 3C 66 C0 C0 CE 66 3A 00
glyph, CC CC CC FC CC CC CC 00
glyph, 78 30 30 30 30 30 78 00
glyph, 1E 0C 0C 0C CC CC 78 00
glyph, E6 66 6C 78 6C 66 E6 00
glyph, F0 60 60 60 62 66 FE 00
glyph, C6 EE FE FE D6 C6 C6 00
glyph, C6 E6 F6 DE CE C6 C6 00
glyph, 38 6C C6 C6 C6 6C 38 00
glyph, FC 66 66 7C 60 60 F0 00
glyph, 7C C6 C6 C6 D6 7C 0E 00
glyph, FC 66 66 7C 6C 66 E6 00
glyph, 7C C6 E0 78 0E C6 7C 00
glyph, FC B4 30 30 30 30 78 00
glyph, CC CC CC CC CC CC FC 00
glyph, CC CC CC CC CC 78 30 00
glyph, C6 C6 C6 C6 D6 FE 6C 00
glyph, C6 C6 6C 38 6C C6 C6 00
glyph, CC CC CC 78 30 30 78 00
glyph, FE C6 8C 18 32 66 FE 00
glyph, 78 60 60 60 60 60 78 00
glyph, C0 60 30 18 0C 06 02 00
glyph, 78 18 18 18 18 18 78 00
glyph, 10 38 6C C6 00 00 00 00
glyph, 00 00 00 00 00 00 00 FF
glyph, 30 30 18 00 00 00 00 00
glyph, 00 00 78 0C 7C CC 76 00
glyph, E0 60 60 7C 66 66 DC 00
glyph, 00 00 78 CC C0 CC 78 00
glyph, 1C 0C 0C 7C CC CC 76 00
glyph, 00 00 78 CC FC C0 78 00
glyph, 38 6C 64 F0 60 60 F0 00
glyph, 00 00 76 CC CC 7C 0C F8
glyph, E0 60 6C 76 66 66 E6 00
glyph, 30 00 70 30 30 30 78 00
glyph, 0C 00 1C 0C 0C CC CC 78
glyph, E0 60 66 6C 78 6C E6 00
glyph, 70 30 30 30 30 30 78 00
glyph, 00 00 CC FE FE D6 D6 00
glyph, 00 00 B8 CC CC CC CC 00
glyph, 00 00 78 CC CC CC 78 00
glyph, 00 00 DC 66 66 7C 60 F0
glyph, 00 00 76 CC CC 7C 0C 1E
glyph, 00 00 DC 76 62 60 F0 00
glyph, 00 00 7C C0 70 1C F8 00
glyph, 10 30 FC 30 30 34 18 00 
glyph, 00 00 CC CC CC CC 76 00
glyph, 00 00 CC CC CC 78 30 00
glyph, 00 00 C6 C6 D6 FE 6C 00
glyph, 00 00 C6 6C 38 6C C6 00
glyph, 00 00 CC CC CC 7C 0C F8
glyph, 00 00 FC 98 30 64 FC 00
glyph, 1C 30 30 E0 30 30 1C 00
glyph, 18 18 18 00 18 18 18 00
glyph, E0 30 30 1C 30 30 E0 00
glyph, 76 DC 00 00 00 00 00 00 
glyph, 00 10 38 6C C6 C6 FE 00 \ char 0x7F
\ Mind the gap!
glyph, 18 18 00 18 18 18 18 00 \ char 0xA1 (NOT 0xA0!)
glyph, 18 18 7E C0 C0 7E 18 18
glyph, 38 6C 64 F0 60 E6 FC 00
glyph, 00 C6 7C C6 C6 7C C6 00
glyph, CC CC 78 FC 30 FC 30 30
glyph, 18 18 18 00 18 18 18 00
glyph, 3E 61 3C 66 66 3C 86 7C
glyph, 00 C6 00 00 00 00 00 00
glyph, 7E 81 9D A1 A1 9D 81 7E
glyph, 3C 6C 6C 3E 00 7E 00 00
glyph, 00 33 66 CC 66 33 00 00
glyph, 00 00 00 FC 0C 0C 00 00
glyph, 00 00 00 7E 00 00 00 00
glyph, 7E 81 B9 A5 B9 A5 81 7E
glyph, FF 00 00 00 00 00 00 00
glyph, 38 6C 6C 38 00 00 00 00
glyph, 30 30 FC 30 30 00 FC 00
glyph, 70 18 30 60 78 00 00 00
glyph, 78 0C 38 0C 78 00 00 00
glyph, 0C 18 30 00 00 00 00 00
glyph, 00 00 33 33 66 7E C0 80
glyph, 7F DB DB 7B 1B 1B 1B 00
glyph, 00 00 00 18 18 00 00 00
glyph, 00 00 00 00 00 18 0C 38
glyph, 18 38 18 18 3C 00 00 00
glyph, 38 6C 6C 38 00 7C 00 00
glyph, 00 CC 66 33 66 CC 00 00
glyph, C3 C6 CC DB 37 6F CF 03
glyph, C3 C6 CC DE 33 66 CC 0F
glyph, E1 32 E4 3A F6 2A 5F 86
glyph, 30 00 30 60 C0 CC 78 00
glyph, 18 0C 38 6C C6 FE C6 00
glyph, 30 60 38 6C C6 FE C6 00
glyph, 7C 82 38 6C C6 FE C6 00
glyph, 76 DC 38 6C C6 FE C6 00
glyph, C6 00 38 6C C6 FE C6 00
glyph, 10 28 38 6C C6 FE C6 00
glyph, 3E 6C CC FE CC CC CE 00
glyph, 78 CC C0 CC 78 18 0C 78
glyph, 30 18 FE C0 FC C0 FE 00
glyph, 0C 18 FE C0 FC C0 FE 00
glyph, 7C 82 FE C0 FC C0 FE 00
glyph, C6 00 FE C0 FC C0 FE 00
glyph, 30 18 3C 18 18 18 3C 00
glyph, 0C 18 3C 18 18 18 3C 00
glyph, 3C 42 3C 18 18 18 3C 00
glyph, 66 00 3C 18 18 18 3C 00
glyph, F8 6C 66 F6 66 6C F8 00
glyph, FC 00 CC EC FC DC CC 00
glyph, 30 18 7C C6 C6 C6 7C 00
glyph, 18 30 7C C6 C6 C6 7C 00
glyph, 7C 82 7C C6 C6 C6 7C 00
glyph, 76 DC 7C C6 C6 C6 7C 00
glyph, C6 00 7C C6 C6 C6 7C 00
glyph, 00 C6 6C 38 6C C6 00 00
glyph, 3A 6C CE D6 E6 6C B8 00
glyph, 60 30 C6 C6 C6 C6 7C 00
glyph, 18 30 C6 C6 C6 C6 7C 00
glyph, 7C 82 00 C6 C6 C6 7C 00
glyph, C6 00 C6 C6 C6 C6 7C 00
glyph, 0C 18 66 66 3C 18 3C 00
glyph, E0 60 7C 66 66 7C 60 F0
glyph, 78 CC CC D8 CC C6 CC 00
glyph, E0 00 78 0C 7C CC 7E 00
glyph, 1C 00 78 0C 7C CC 7E 00
glyph, 7E C3 3C 06 3E 66 3F 00
glyph, 76 DC 78 0C 7C CC 7E 00
glyph, CC 00 78 0C 7C CC 7E 00
glyph, 30 30 78 0C 7C CC 7E 00
glyph, 00 00 7F 0C 7F CC 7F 00
glyph, 00 00 78 C0 C0 78 0C 38
glyph, E0 00 78 CC FC C0 78 00
glyph, 1C 00 78 CC FC C0 78 00
glyph, 7E C3 3C 66 7E 60 3C 00
glyph, CC 00 78 CC FC C0 78 00
glyph, E0 00 70 30 30 30 78 00
glyph, 38 00 70 30 30 30 78 00
glyph, 7C C6 38 18 18 18 3C 00
glyph, CC 00 70 30 30 30 78 00
glyph, 08 3C 08 7C CC CC 78 00
glyph, 00 F8 00 F8 CC CC CC 00
glyph, 00 E0 00 78 CC CC 78 00
glyph, 00 1C 00 78 CC CC 78 00
glyph, 78 CC 00 78 CC CC 78 00
glyph, 76 DC 00 78 CC CC 78 00
glyph, 00 CC 00 78 CC CC 78 00
glyph, 30 30 00 FC 00 30 30 00
glyph, 00 02 7C CE D6 E6 7C 80
glyph, 00 E0 00 CC CC CC 7E 00
glyph, 00 1C 00 CC CC CC 7E 00
glyph, 78 CC 00 CC CC CC 7E 00
glyph, 00 CC 00 CC CC CC 7E 00
glyph, 18 30 CC CC CC 7C 0C F8
glyph, F0 60 7C 66 7C 60 F0 00 
glyph, 00 CC 00 CC CC 7C 0C F8 \ char 0xFF

( s: font-addr) CONSTANT font8

: glyphidx  ( char -- n )  \ return index of glyph in font8 table
   DUP 20 80 WITHIN IF 20 - EXIT THEN     \ ascii range
   DUP 0A1 100 WITHIN IF 041 - EXIT THEN  \ latin-1 range
   20 ;  \ unknown chars mapped to white-space
: glyph  ( char -- c-addr ) \ return 8x8 glyph of char
   \ format: top to bottom, bit7=left-most, bit0=right-most bit
   glyphidx 3 LSHIFT font8 + ;

Nachdem man den LED-Treiber und 8×8 Font aus den Beispielen oben geladen hat, kann man folgenden Ticker laden. Dieser benutzt außer dem Stack keinen RAM! Der Bildschirminhalt wird dynamisch generiert und direkt ohne Video-RAM als Zwischenspeicher an das Display geschickt.

Der 8×8 Font im Format für PC-Displays ist aus Sicht des LED-Displays gespiegelt. Als Ausgleich schicken wir die Zeilen in umgekehrter Reihenfolge, das Display muss, damit das passt, dann auf dem Kopf stehen. Beenden tut man den Ticker per Tastendruck q vom Terminal.

\ Display text ticker on 8x8 LED panel
\ Copyright (C) David Kuehling <dvdkhlng TA gmx TOD de> 2012
\
\ Created: May 2012       License: GPLv2+; NO WARRANTY
\
\ NOTE: LOAD ./leds.FS AND ./font8.fs FIRST!

: char@  ( c-addr u idx -- char )  \ get char from string, space when outside
   TUCK U> IF  + C@ EXIT THEN
   2DROP BL ;
: 3dup  ( x1 x2 x3 -- x1 x2 x3 x1 x2 x3 )
   DUP 2OVER ROT ;
: char@2  ( c-addr u idx -- char1 char2 )  \ get char and next char
   3dup 1+ char@ >R  char@ R> ;
: glyph@2  ( char1 char2 row -- x )  \ fetch row from 2 glpyhs into 16-bit
   >R glyph R@ + C@
   SWAP glyph R> + C@  8 LSHIFT OR ;

: ticker-row  ( c-addr u offset row -- x )
   OVER >R >R
   3 RSHIFT char@2  R> glyph@2	\ get glyph of two chars at idx offs/8
   8 R> 7 AND - RSHIFT ;        \ shift by offs%8 and return high part
: ticker-frame  ( c-addr u offset -- )
   framestart
   0 7 DO		\ Rolf's display is mirrored, we mirror by row 
      3dup I ticker-row pixels!
   -1 +LOOP
   2DROP DROP ;
: ticker  ( c-addr u -- )
   BEGIN
      DUP 8 * 0 DO
         2DUP I ticker-frame 28 MS
         KEY? IF KEY [CHAR] q = IF 2DROP UNLOOP EXIT THEN THEN
      LOOP
   AGAIN ;

\ Beispiel:
: msg IS"  Forth-Gesellschaft e.V.-Wir programmieren Forth  " ;
ledinit msg ticker