ATOS - Around The Operating System Das ATOS-Magazin 1/97

# Forth-Kurs, Teil 3

Von Rainer Saric

In diesem dritten Teil des FORTH-Kurses erfahren Sie etwas über
Forth Interpreter
Datenstrukturen & GEMDOS
Die Vokabulare
Schleifen & Programmablaufsteuerung
Anwendung
Looking Eyes

Ich gehe bei der Beschreibung davon aus, das die Datei Forth.ini beim Programmstart korrekt geladen wurde (geschieht normalerweise automatisch), da hier Utilities nachgeladen werden, u.a. gemdos.

### Fehlerberichtigung

Mit dieser ATOS-Ausgabe liegt ein überarbeitete mForth-Version in der MAUS LB. (forth.zip)

Hier die wichtigsten Änderungen:

bload:
  BIN-Files werden jetzt das Wörterbuch geladen - kein "m_alloc" mehr

make:
  - schreibt auf Wunsch Symboltabelle ins Programm
  - Speicherverwaltung geändert (nur ein "m_alloc")
  - schreibt auf Wunsch Symboltabelle auf Disk

sonst:
  diverse Korrekturen im GEM/VDI.

### Forth Interpreter

In der letzten Ausgabe betrachteten wir uns kurz den äußeren Interpreter von Forth quit. Jetzt werfen wir einen genaueren Blick auf interpret.

Zur Erinnerung die Definition von quit:

    : quit ( -- )
       r0 @ rp !    /* Returnstackpointer setzen */
       state off    /* Interpretmodus */
       begin        /* Quit ist eine Endlosschleife */
          .status   /* Status ausgeben */
          query     /* Auf eine Eingabe warten .. */
          interpret /* .. und diese interpretieren */
       repeat ;

interpret ist etwas umfangreicher:

    : interpret ( -- )
       bl word      /* nächstes Wort aus dem Inputstream extrahieren */
       nullstr? not /* Nullstring ? */
       if    find -1 = not      /* Wort im Wörterbuch suchen */
             if    /* gefunden, ToS: pfa contrl-flag */
                   state @      /* compilieren oder interpretieren */
                   if    com,   /* compile Wort */
                   else  /* interpretieren */
                         dup 2 = /* restrict ? */
                         if    true abort" compile only"
                         else  drop execute   /* Wort ausführen */
                         endif
                   endif
             else  /* Wort nicht gefunden, vielleicht war es eine Zahl */
                   number? 0=
                   if   /* Nein! Wort unbekannt */
                        type /* Wort */ true abort"  not found"
                   else state @ /* Zahl kompilieren ? */
                        if      [compile] literal   /* Ja */
                        endif
                   endif
             endif
       endif ; /* end interpret */

Auch der Interpreter ist also vollkommen in Forth implementiert. Aus der Einfachheit erklärt sich auch die Tatsache, daß Sie relativ viel von Hand erledigen müssen. Das gibt Ihnen jedoch die Möglichkeit, den erzeugten Code weitgehend selbst zu bestimmen.

Liste der verwendeten Worte

WORD | Stack | Beschreibung
bl | ( - ) | Legt den ASCII-Code der Leertaste auf
|  | den Stack, entspricht: 32 constant bl
word | ( - adr ) | separiert nächtes Word aus dem Inputstrom
nullstr? | -- adr flag | Testet String auf dem Stack
find | adr -- pfa flag | sucht Wort im Wörterbuch, 0> wenn gefunden
[ | -- | Wechsel in den Interpret Modus
] | -- | Wechsel in den Compile Modus
literal | n -- | compiliert Zahl
abort" | flag -- <string>" | Wenn flag = TRUE
|  | Stack leeren und Error-Routine aufrufen
error" | flag -- <string>" | wie abort", jedoch wird
|  | der Stack nicht gelöscht

Es ist möglich, innerhalb einer Colon-Defintion vom Compiler in den Interpreter zu wechseln und wieder zurück. Dies kann sinnvoll sein, wenn Berechnungen während der Compiletime erfolgen sollen. Als Beispiel diene die Addition von Flags, z.B. für GEM-Fenster:

    : CreateWin
        [ WNAME INFO + ] literal ..... stuff
    ;

### Datenstrukturen & GEMDOS

Das Betriebssystem des ST ist in C geschrieben. Es stellt sich daher die Frage: Wie kann ich auf die Strukturen des Betriebssystems unter Forth zugreifen? Als Beispiel wähle ich eine Funktion aus dem GEMDOS: Fsfirst

WORD | Stack | Beschreibung
f_setdta | ( adr - flag ) | Setzt DTA
f_sfirst | ( str - flag ) | sucht erstes File auf
|  | den das Pattern in str paßt
create | -- <name> | erzeugt eine Eintrag ins Wörterbuch
allot | n -- | setzt Dictionarypointer um n Bytes vor
compile | -- <name> | compiliert nächstes Wort
[compile] | -- <name> | erzwingt Compilation des nächsten Wortes
|  | bei immediate Worten

Zunächst die Struktur des Disk Transfer Address in C:

    typedef struct
    {
        BYTE    d_reserved[21];  /* für GEMDOS reserviert */
        UBYTE   d_attrib;        /* Datei-Attribut        */
        UWORD   d_time;          /* Uhrzeit               */
        UWORD   d_date;          /* Datum                 */
        ULONG   d_length;        /* Dateilänge            */
        BYTE    d_fname[14];     /* Dateiname             */
    } DTA;

Das kann so nicht übernommen werden. Zählen wir zunächst alle Bytes der Struktur zusammen: 44 Bytes.

Schritt 1:

    create myDTA 44 allot

Wir haben jetzt Platz für die Daten der DTA im Wörterbuch geschaffen. Um auf die einzelnen Strukturelemente zuzugreifen, wäre es möglich zu myDTA immer das nötige Offset zu addieren: myDTA 21 + zeigt dann auf UBYTE d_attrib. Einfacher wird's, wenn die Offsets als Constants definiert werden.

Schritt 2:

    /* d_reserved interessiert nicht, da eh' reserviert */
    21 constant d_attrib
    22 constant d_time
    24 constant d_date
    26 constant d_enght
    30 constant d_fname

Mit dieser Struktur führen wir einen f_sfirst - Aufruf durch. HALT! Das Betriebssystem kennt die neue Adresse noch nicht! Diese muß erst über die Funktion f_setdta gesetzt werden.

    mforth gemdos also      /* Worte zugäglich machen */
    myDTA f_setdta .        /* Return der Funktion gleich ausgeben */
    s" *.*" f_sfirst .      /* erwartet einen 'Suchstring' */
    myDTA d_fname + type    /* Filenamen ausgeben */

Schön wäre es natürlich, wenn die Strukturen aus C genutzt werden könnten. Mit kleinen Einschränkungen läßt sich dies auch implementieren.

typedef kann als : typedef ; definiert werden. Es tut allerdings nichts (außer Platz zu verbrauchen) und kann daher wegfallen.

    variable __struct   /* TRUE, wenn innerhalb typedef struct */
    : struct ( -- ) __struct on ;
    : {      ( -- 0 ) 0 ; /* Zähler für die Strukturlänge auf den Stack */

Zur Erstellung der Offsets entwickeln wir ein Wort, das a) einen Wörterbucheintrag erzeugt und b) den Zähler um n Bytes hochzählt.

    : field ( n -- <name> )
        create dup , /* Offset merken */ + /* Zähler auf ToS erhöhen */
        does> ( -- adr )
               @ /* Offset holen */
               state @ /* Im Compile mode Zahl und + compilieren */
               if   [compile] literal compile +
               else + /* Interpret mode, nur addieren */
               endif ;

Den Namen der ganzen Struktur konnten wir immer noch nicht eingeben. Das erledigt das letzte Wort: }

    : { ( n -- <name> )
        create , /* Länge der Struktur merken */ __struct off
        does> ( -- <name> | n )
              @ __struct @ 0= if create allot /* Erzeuge Struktur */ endif ;

Und hier das Endergebnis:

    struct /* DiskTransferAddress */
    {
       21 field d_reserved
        1 field d_attrib
        2 field d_time
        2 field d_date
        4 field d_lenght
       14 field d_fname
    } DTA

Für unser Beispiel heißt dies:

    DTA myDTA
    myDTA f_setdta .
    s" *.*" f_sfirst .
    myDTA d_fname type /* es muß jetzt nicht mehr addiert werden! */

Um auf die einzelnen Strukturen zugreifen zu können, muß allerdings nicht immer Speicher reserviert werden. Da field einfach einen Offset addiert, kann sich die Struktur irgendwo im Speicher befinden. Unser Beispiel unter Verwendung von Zeigern:

    DTA myDTA
    integer *dta
    myDTA to *dta
    /* *dta dname */

Statt integer läßt sich auch eine Variable als Zeiger verwenden:

    DTA myDTA
    variable *dta
    myDTA *dta !
    /* *dta @ dname */

Beispiele für den Zugriff auf das Filesystem finden sich im File: source\command.4th.

(In mForth sind die Worte: struct, {, }, sizeof und field bereits implementiert).

### Die Vokabulare

Eines unserer ersten Worte, das wir angewendet hatten, war words. Es listete uns alle Worte eines Vokabulars auf. Wie Sie vermuten, wird die Zeit zur Suche nach bereits definierten Worten mit wachsender Anzahl von Worten zunehmen. Abgesehen davon wird das System mit nur einem Vokabular recht unübersichtlich. Genau hier setzt das Definitionswort: vocabulary an. Es erzeugt einen neuen Wörterbucheintrag, in den jetzt neue Worte kompiliert werden können (in mForth sind bereits einige Vocabulare vorhanden: forth, only, vdi, gem, assembler, hidden). Dabei ist das neue Vokabular Bestandteil eines übergeordneten Vokabulars.

In Forth können Sie mehrmals dasselbe Wort definieren, nur wird beim Durchsuchen immer zuerst das letzte kreierte Wort gefunden werden, d.h. Sie können alten Worten neue Bedeutung verleihen. Das hat Vor-, aber natürlich auch Nachteile. Über die Vokabulare können Sie Ihre neue Worte in ein gesondertes Vokabular ablegen. Die Suchreihenfolge läßt sich wie, wir gleich sehen werden, mit ein paar Befehlen leicht beeinflussen.

WORD | Stack | Beschreibung
vocabulary | -- <name> | Erzeugen eines neuen Wörterbuchs
voc-link | -- adr | hält Pointer auf PFA des jüngsten Vokabulars
current | -- adr | hält Pointer auf PFA des Current Vokabulars
context | -- adr | hält Pointer auf PFA des Context Vokabulars
definitions | -- | macht Context Voc zum Current Voc
also | -- | trägt das aktuelle transiente Voc als
|  | erstrangigesresidentes Vocabular in den
|  | voc-stack ein
toss | -- | entfernt erstrangiges Vokabular vom voc-stack
order | -- | Anzeige der Suchreihenfolge und des
|  | Current Vokabulars
|  | Definiert in system\util.4th
only | -- | voc-stack löschen
|  | only ist jetzt einziges Vokabular
|  | mit dem Pointer auf forth
mforth | -- | Suchreihenfolge auf: forth gem vdi only

Das sieht wieder 'mal viel schlimmer aus als es ist. Anhand eines Beispiels läßt sich das Prinzip verdeutlichen.

Sie stellen die aktuelle Suchreihenfolge über den Befehl mforth her, dann ist:

    Transient: forth
      Current: forth
      Context: forth gem vdi only

(Diese 'Tabelle' liefert das Wort: order, order findet sich in util.4th)

Nehmen wir an Sie definieren jetzt das Vokabular complex dann wird zuerst ein neuer Wörterbucheintrag erzeugt (ansehen mit words) Als nächstes müssen Sie das Vokabular auf den voc-stack bringen, das erledigt complex also

    Transient: complex
      Current: forth
      Context: complex forth gem vdi only

Alle Worte die Sie jetzt definieren, würden jedoch weiterhin in das Vokabular forth compiliert. complex wird lediglich (erfolglos) durchsucht.

Das Tüpfelchen stellt in diesem Fall definitions dar.

    Transient: complex
      Current: complex
      Context: complex forth gem vdi only

Jedes neue Wort wird jetzt in das Vokabular complex compiliert. Dabei wird complex zuerst durchsucht, dann forth -> gem -> vdi und schließlich only. (only forth ist die kleinstmögliche sinnvolle Suchreihenfolge, da only nur das Wort forth kennt)

Erzeugen Sie in complex jetzt Worte wie: + - *, ...., so werden diese nur gefunden, wenn sich complex in der Suchreihenfolge befindet.

Zusammenfassung:

    mforth
    vocabulary complex
    complex also definitions
    : + ( c1 c2 -- c3 )  ..... ; /* usw */
    mforth

Liegen zwei komplexe Zahlen auf dem Stack und Sie wollen diese addieren, so würde jetzt bei der eingestellten Suchreihenfolge das + aus dem forth Vokabular ausgeführt werden. Geben Sie jedoch vorher complex ein wird dieses Vokabular als erstes durchsucht und jetzt das richtige + gefunden.

### Schleifen & Programmablaufsteuerung

Forth bietet Ihnen mehr Möglichkeiten der Programmablaufsteurung als nur die einer do .. loop-Schleife oder if .. (else) .. endif-Anweisung.

In unserem heutigen Anwendungsbeispiel finden Sie:

1. `begin .. ( while ) .. repeat ( until )`

   `begin` markiert den Anfang einer bedingten Schleife. Nach Erreichen der Abbruch-Bedingung wird das Programm hinter `repeat (until)` fortgesetzt.

   Anwendung in der Form:

       begin ... flag while ... repeat

       begin ... flag until

   Mit `begin ... repeat` kann eine Endlosschleife erzeugt werden.

       : bis1000 ( -- )  0 begin dup 1001 < while 1+ repeat . ;
       : bis1000 ( -- )  0 begin 1+ dup 1000 = until . ;
       : ewig    ( -- )  0 begin 1+ repeat ;

2. begin-case .. case .. break end-case

       : ... ( flag -- )
           begin-case
               1 case ." Hallo"    break
               2 case ." Tschüss"  break
               ." Kein Kommentar"  /* Default, nicht zwingend */
           end-case

### Anwendung

Das Anwendungsbeispiel des heutigen Kursteils ist etwas umfangreicher. Sie zeigt Ihnen u.a. die Nutzung des GEM/VDI - Wörterbuchs. Grundlage des Bindings war das Profibuch. Für GEM-Funktionen gilt: Oben auf dem Stack liegen grundsätzlich diejenigen Parameter, die ins addrin-Array eingetragen werden müssen, darunter jene des intin-Arrays. Für die VDI-Funktionen gilt: die Daten für das pstin-Array liegen oben, dann die Daten für das intin-Array.

Wahrscheinlich haben Sie die EYES unter MultiTOS a.ä. schon gesehen. Heute folgt also die Forth-Version.

Ich kommentiere den Sourcecode etwas ausführlicher (Der Quelltext befindet sich auch in der neuen mForth-Version im Ordner APPS).

Wenn Sie unter SingleTOS arbeiten und im Interpretmode GEM-Aufrufe getätigt werden, sollte forth.tos auf jeden Fall in forth.prg umbenannt werden.

Zu Beginn werden, wie in anderen Sprachen üblich, Files geladen, die für verschiedene Applikationen nützlich sind. Es folgen dann die Definitionen die für das Programm relevant sind (Variable, Strukturen, etc).

Für unsere Eyes werden ein paar Recktecke benötigt, die die Ausmaße des Desktops, des Eyes-Windows etc. aufnehmen (GRECT in aes.h). Ich beginne mit dem letzten Wort von Eyes: `main`

appl_init dup ap_id w! 0>= meldet uns beim AES an, im Fehlerfall liefert appl_init einen Wert <0. Wir sichern unsere ID in ap_id

Hinweis:Bei allen GEM/AES-Funktionen findet sich, wenn die Funktion Werte zurückgibt, intout[0] immer oben auf dem Stack!

arrow den Mauszeiger als Pfeil

Um die VDI-Workstation anzumelden, müssen wir uns zunächst das Phys-Handle holen, dies erledigt die Funktion graf_handle, der Rückgabewert wird in v_handle gesichert. Die restlichen Werte sind nicht hier nicht von Bedeutung, also 4drop

Jetzt wird kann die VDI-Workstation geöffnet werden. [ xbios ] getrez 2+ 1 1 1 1 1 1 1 1 1 2 opnvwk jetzt muß das korrekte VDI-Handle geholt und gesichert werden contrl 12 + w@ v_handle w! Bei einer AES-Version > 0x400 teilen wir diesem mit, das unser Programm einen Shutdown versteht:

global w@ $400 >= if SHW_MSGTYPE 1 0 0 0 shel_write drop endif

Und DoEyes schließlich arbeitet alle Events bis zum bitteren Ende ab. Es bleibt dann nur noch, die VDI-Workstaition zu schließen und unsere Applikation abzumelden. Dies geschieht mit clsvwk und appl_exit.

Was tut DoEyes u.a. im einzelnen?

1. holt die Ausmaße desa Desktops und sichert sie in desk

2. erzeugt ein Fenster mit diesen Außmaßen

3. setzt Fenstername und Fenterinfo

4. errechnet die Ausmaße und die Position des Fensters (center)

5. öffnet das Fenster

6. ruft do_events auf

7. Schließen und Löschen des Fensters

Die Hauptaufgabe von do_events ist die Abarbeitung der eingehenden Nachrichten. Für Eyes sind nur Nachrichten von Bedeutung, die das Fenster sowie den Timer betreffen. Fünf Timerereignisse pro Sekunde sind ausreichend. Die Schleife wird erst verlassen, wenn done wahr ist. In der Infozeile des Fensters lassen wir uns zusätzlich die aktuelle Zeit anzeigen.

blank übernimmt das Neuzeichnen des Fenster, dabei muß auf das Clipping geachtet werden, denn es soll ja kein darüberliegendes Fenster überpinselt werden.

redraw schickt der eigenen Appliaktion die Nachricht, das neu gezeichnet werden soll.

Das Wort sqrt zieht die Wurzel aus der auf dem Stack liegenden Zahl. Negative Werte werden nicht abgefangen, da sie hier nicht auftreten können.

now wandelt die Zeit, die im GEMDOS-Format vorliegt, in einen String um. Format: 13:00:02

Tabelle 57: GEM-Befehle
WORD | Stack | Beschreibung
appl_init | -- id | Anmeldung beim AES
|  | Fehler bei id<0
appl_exit | -- | Programm abmelden
appl_write | id len buf -- | Mitteilung senden
evnt_multi | .... -- .... | Profibuch / tos.hyp
form_alert | icon str -- button | Standardalertbox
wind_name | hdl str -- | Makro, setzt Fenstername
wind_info | hdl str -- | Makro, setzt Fenterinfo
wind_update | flag -- | Fenster wird neu gezeichnet
wind_create | flag x y w h -- hdl | Fenster erzeugen
wind_open | hdl x y w h -- | Fenster öffnen
wind_close | hdl -- | Fenster schließen
wind_delete | hdl -- | Fenster löschen
wind_set | hdl flag n1 n2 n3 n4 -- | Fensterstatus ändern
wind_get | hdl field -- intout[1]..[4] | Fensterstatus erfragen
wind_calc | typ kind x y w h -- x' y' w' h' | Fensterausmaße berrechnen
show_mouse | -- | Makro, Mauszeiger ein
hide_mouse | -- | Makro, Mauszeiger aus
graf_mkstate | -- mx my kstate mstate | Mouse und Keyboard
|  | ermitteln

Tabelle 58: VDI-Befehle
WORD | Stack | Beschreibung
opnvwk | ... -- | virtuelle Workstation öffnen
clsvwk | -- | Workstation schließen
bar | x y w h -- | gefülltes Rechteck zeichnen
circle | x y radius -- | Kreis zeichnen
ellipse | x y xradius yradius -- | ellipse zeichnen
s_clip | x y x' y' flag -- | Clipping setzen oder aufheben
sf_color | color -- | Füllfarbe setzen

Tabelle 59: Extends
WORD | Stack | Beschreibung
GRECT | -- <name> | reserviert 8 Bytes für <name>
variable: | -- .... ; | definiert mehrere Variable
4drop | n1..ni-- | 4 Stackeinträge drop'en'
4w@ | adr -- w1 w2 w3 w4 | 4 16bit Zahlen holen
4w! | w1 w2 w3 w4 adr -- | 4 16bit Zahlen sichern
pair+ | n m x y -- n+x m+y | Paarweises addieren
rc_inter | x..h x'..h' -- x`..h' flag | Intersection
|  | zweier Rechtecke finden
rc_copy | adr1 adr1 -- | 8 Bytes von adr1 nach adr2

### Looking Eyes

Sie können den Sourcecode über die Kopierfunktion des ST-Guide in das Clipboard kopieren. Dieser Text (scrap.txt) kann in einen ASCII-Editor geladen werden und als eyes.4th o.ä. gesichert werden.

    /*
       mForth EYES
       -----------
    */
    mforth
    #ifndef xbios bload bin\xbios.bin >voc xbios #endif

    true constant APP immediate
    system macro on

    include gem\aes.h
    include gem\gemdefs.h

    mforth gemdefs also

    GRECT work
    GRECT desk
    GRECT r2
    GRECT icnws

    variable: what wx wy x y mx my oldx oldy oldt ;
    variable: ap_id ev_mox ev_moy event iconified ;
    -1 wx ! -1 wy !
    integer whandle
    integer done
    integer f1
    integer f2

    8 warray msgbuff
    8 warray sndbuff
    8 warray pxy

    create timestr 16 allot

    : sqrt ( x -- x' )
       dup 0= if exit endif 16
       begin 2dup /mod nip
             over + 2/ dup rot - abs 2/
       while repeat  nip ;

    : pupil ( mx my x -- )
       iconified ?if 20 else 40 endif
       y ! x ! my ! mx !
       mx @ work g_x w@ x @ + -
       my @ work g_y w@ y @ + -
       2dup
       dup * >r dup * r> + sqrt
       dup
       if    rot     f1 * over /
             -rot >r f2 * r> /
       else  drop 0 0
       endif >r >r

       work g_x w@ x @ + r> +
       work g_y w@ y @ + r> + iconified ?if 6 else 10 endif circle ;

    : now  ( packed -- )
      <# dup $1F   and  2*   # # drop ascii : hold
         dup $7E0  and  5 >> # # drop ascii : hold
             $F800 and 11 >> # # #> drop timestr strcpy ;

    : blank ( -- )    /* blank default window */
       BEG_UPDATE wind_update
       whandle WF_WORKXYWH wind_get work 4w!
       3 msgbuff w@ WF_FIRSTXYWH wind_get
       begin    2dup +
       while    4 msgbuff 4w@ rc_inter
                if    hide_mouse
                      1 1 pair- xywh>xyxy 4dup r2 4w! 1 s_clip
                      r2 4w@ 0 sf_color 0 sf_interior bar
                      1 sf_color
                      iconified
                      ?if   work w@               16 + work g_y w@ 20 + 10 18 ellipse
                            work w@ work g_w w@ + 16 - work g_y w@ 20 + 10 18 ellipse
                            0 sf_color 1 sf_interior
                            oldx @ oldy @             16   pupil
                            oldx @ oldy @ work g_w w@ 16 - pupil
                            2 sf_color
                            ev_mox @ ev_moy @             16   pupil
                            3 sf_color
                            ev_mox @ ev_moy @ work g_w w@ 16 - pupil
                      else  work w@               25 + work g_y w@ 40 + 20 35 ellipse
                            work w@ work g_w w@ + 25 - work g_y w@ 40 + 20 35 ellipse
                            0 sf_color 1 sf_interior
                            oldx @ oldy @             25   pupil
                            oldx @ oldy @ work g_w w@ 25 - pupil
                            2 sf_color
                            ev_mox @ ev_moy @             25   pupil
                            3 sf_color
                            ev_mox @ ev_moy @ work g_w w@ 25 - pupil
                      endif
                      show_mouse
                else  4drop
                endif
                3 msgbuff w@ WF_NEXTXYWH wind_get
       repeat   2drop 2drop
       END_UPDATE wind_update ;

    : redraw    ( -- )
       WM_REDRAW 0 sndbuff w!
       ap_id w@  1 sndbuff w!
       whandle   3 sndbuff w!
       work 4 sndbuff rc_copy
       ap_id w@ 16 0 sndbuff appl_write drop ;

    : do_events ( -- )
       whandle WF_WORKXYWH wind_get work 4w!  /* Get current size of Window */
       begin    [ MU_MESAG MU_TIMER + ] literal
                0 0 0  0 0 0 0 0  0 0 0 0 0  200 0
                0 msgbuff evnt_multi event ! 2drop 2drop ev_moy ! ev_mox !
                event @ MU_MESAG and
                if       0 msgbuff w@
                         begin-case
                            WM_CLOSED
                               case  true to done
                               break
                            WM_REDRAW
                               case  blank
                               break
                            WM_MOVED
                               case  3 msgbuff w@ 5
                                     4 msgbuff 4w@ wind_set
                                     blank
                               break
                            WM_TOPPED
                               case whandle WF_TOP 0 0 0 0 wind_set
                               break
                            WM_ICONIFY
                               case  whandle wind_currxywh icnws 4w!
                                     whandle WF_ICONIFY 4 msgbuff 4w@ wind_set
                                     iconified on
                                     5 to f1
                                     9 to f2
                               break
                            WM_ALLICONIFY
                               case  whandle WF_ICONIFY icnws 4w@ wind_set
                                     iconified off
                                     5 to f1
                                     9 to f2
                               break
                            WM_UNICONIFY
                               case  whandle WF_UNICONIFY icnws 4w@ wind_set
                                     iconified off
                                      9 to f1
                                     20 to f2
                               break
                            AP_TERM  /* Handle shutdown   */
                               case true to done
                               break
                         end-case
                endif
                event @ MU_TIMER and
                if    graf_mkstate drop nip nip 0=
                      if    ev_mox @ oldx @ - abs 4 >
                            ev_moy @ oldy @ - abs 4 > or
                            if    redraw
                                  ev_mox @ oldx !
                                  ev_moy @ oldy !
                            endif
                      endif
                      [ xbios ] gettime oldt @ over <>
                      if    dup oldt ! now
                            whandle timestr wind_info
                      else  drop
                      endif
                endif
       done until ;

    : DoEyes ( -- )
       0 4 wind_get desk 4w!   /* Size Desk */
       [ WNAME MOVER + CLOSER + INFO + SMALLER + ] literal
       0 0 32767 32767 wind_create dup to whandle /* max size of window  */
       0<    /* Important, if you don't use Multitasking     */
       if    1 s" [1][No more windows!][ Uh Oh ]" form_alert drop
       else  whandle s" Eyes" wind_name
             whandle s"     " wind_info
             wx @ 0<
             if    WC_BORDER [ WNAME MOVER + CLOSER + INFO + SMALLER + ] literal
                   100 100 100 116 wind_calc >r >r 2drop
                   desk g_w w@ r> - 2/      wx !
                   desk g_h w@ r> - 2/ 16 + wy !
             endif

             iconified off
              9 to f1
             20 to f2
             whandle wx @ wy @ 100 116 wind_open

             do_events

             whandle wind_close
             whandle wind_delete
       endif ;

    : main   ( -- )
       appl_init dup ap_id w! 0>=
       if    arrow
             graf_handle v_handle w! 4drop
             [ xbios ] getrez 2+ 1 1 1 1 1 1 1 1 1 2 opnvwk
             contrl 12 + w@ v_handle w!
             global w@ $400 >=
             if  SHW_MSGTYPE 1 0 0 0 shel_write drop   endif
             DoEyes
             clsvwk
             appl_exit
       endif
       APP #if 0 return #endif ;

    APP #if
       system make eyes.app bye
    #endif

### Vorschau auf die nächste Folge

Im 4. und letzten Teil möchte ich noch kurz auf folgende Themen eingehen:

- Ausführung von Worten

- Fehlerbehandlung

- Erstellung von Programmen und Beachtenswertes

Anrufen (06431-71188 ab 20.00) oder schreiben:

MausNet: Rainer Saric

RS