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

ATOS Programmierpraxis ATOS Programmierpraxis

Forth-Kurs, Teil 3

Von Rainer Saric

 Bild ue_prog1




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

WORDStackBeschreibung
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 flagTestet String auf dem Stack
findadr -- pfa flagsucht Wort im Wörterbuch, 0> wenn gefunden
[--Wechsel in den Interpret Modus
]--Wechsel in den Compile Modus
literaln --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

WORDStackBeschreibung
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
allotn --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.

WORDStackBeschreibung
vocabulary-- <name>Erzeugen eines neuen Wörterbuchs
voc-link-- adrhält Pointer auf PFA des jüngsten Vokabulars
current-- adrhält Pointer auf PFA des Current Vokabulars
context-- adrhä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.

 Bild eyes




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
WORDStackBeschreibung
appl_init-- idAnmeldung beim AES
Fehler bei id<0
appl_exit--Programm abmelden
appl_writeid len buf --Mitteilung senden
evnt_multi.... -- ....Profibuch / tos.hyp
form_alerticon str -- buttonStandardalertbox
wind_namehdl str --Makro, setzt Fenstername
wind_infohdl str --Makro, setzt Fenterinfo
wind_updateflag --Fenster wird neu gezeichnet
wind_createflag x y w h -- hdlFenster erzeugen
wind_openhdl x y w h --Fenster öffnen
wind_closehdl --Fenster schließen
wind_deletehdl --Fenster löschen
wind_sethdl flag n1 n2 n3 n4 --Fensterstatus ändern
wind_gethdl field -- intout[1]..[4]Fensterstatus erfragen
wind_calctyp 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 mstateMouse und Keyboard
ermitteln

Tabelle 58: VDI-Befehle
WORDStackBeschreibung
opnvwk... --virtuelle Workstation öffnen
clsvwk--Workstation schließen
barx y w h --gefülltes Rechteck zeichnen
circlex y radius --Kreis zeichnen
ellipsex y xradius yradius --ellipse zeichnen
s_clipx y x' y' flag --Clipping setzen oder aufheben
sf_colorcolor --Füllfarbe setzen

Tabelle 59: Extends
WORDStackBeschreibung
GRECT-- <name>reserviert 8 Bytes für <name>
variable:-- .... ;definiert mehrere Variable
4dropn1..ni--4 Stackeinträge drop'en'
4w@adr -- w1 w2 w3 w44 16bit Zahlen holen
4w!w1 w2 w3 w4 adr --4 16bit Zahlen sichern
pair+n m x y -- n+x m+yPaarweises addieren
rc_interx..h x'..h' -- x`..h' flagIntersection
zweier Rechtecke finden
rc_copyadr1 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:

Anrufen (06431-71188 ab 20.00) oder schreiben:

MausNet: Rainer Saric

RS


ATOS Programmierpraxis ATOS Programmierpraxis