(********************************************************************** :Program. VTrainer.mod :Contents. Programm zum Abfragen von Vokabeln oder ähnlichem :Author. Dieter WILHELM :Address. Albert-Schweitzer-Str.44, 8000 München 83 :Phone. 089/671693 :Copyright. PD :Language. Modula-2 :Translator. M2Amiga A+L V4.0d :Imports. IntuiStruct1.3 [bne] Amok#3, Lists [bne] Amok#22, :Imports. Request, VAbfrage, VAnzeige, VDisk, VEdit, VEingabe, :Imports. VHilfe, VInfo, VMenue, VStat :History. V1.0 Dieter WILHELM 13.Jan.1991 :History. V1.1 Dieter WILHELM 29.Sept.1991 **********************************************************************) MODULE VTrainer ; FROM Arts IMPORT Assert; FROM DosD IMPORT FileHandlePtr, ProcessPtr, readOnly; FROM DosL IMPORT Close, Open, Read; FROM ExecL IMPORT FindTask, GetMsg, ReplyMsg, WaitPort; FROM GraphicsD IMPORT jam1; FROM IntuiStruct IMPORT ItemNum, MakeNum, MenuNull, MenuNum, NoItem, NoSub, SubNum; FROM IntuitionD IMPORT IDCMPFlags, IDCMPFlagSet, IntuiMessage, IntuiText, WindowPtr; FROM IntuitionL IMPORT AutoRequest, OffMenu, OnMenu; FROM Lists IMPORT CreateList, EntriesInList, EntryPtr, DeleteList; FROM Request IMPORT aslORarp; FROM SYSTEM IMPORT ADR, CAST; FROM VAbfrage IMPORT Abfrage; FROM VAnzeige IMPORT Anzeige; FROM VDisk IMPORT Ausgabe, Lesen, Schreiben; FROM VEdit IMPORT Ed; FROM VEingabe IMPORT Eingabe, Modus, VKopf, Vokabel; FROM VHilfe IMPORT Hilfe; FROM VInfo IMPORT Info; FROM VMenue IMPORT attr, Window; FROM VStat IMPORT Stat; VAR WPtr : WindowPtr ; IntuiMsg : POINTER TO IntuiMessage ; meldung, laden, ende, zurueck, eingabe, menu, keineDat, ok, liste : IntuiText ; class : IDCMPFlagSet ; code, MNr, INr, SNr : CARDINAL ; Kopf : VKopf ; Vok : Vokabel ; fHandle : FileHandlePtr; Eintrag : EntryPtr ; gespeichert, neu, fehler : BOOLEAN ; m : CARDINAL ; r : LONGINT; myProc : ProcessPtr; oldWin : WindowPtr; owin : BOOLEAN; dummy : BOOLEAN; PROCEDURE Auswertung(VAR MNr, INr, SNr: CARDINAL; code: CARDINAL) ; BEGIN MNr := MenuNum(code) ; INr := ItemNum(code) ; SNr := SubNum(code) ; END Auswertung ; PROCEDURE Initialisieren ; BEGIN gespeichert := TRUE ; neu := TRUE; owin := FALSE; WITH liste DO frontPen := 0 ; backPen := 1 ; leftEdge := 15 ; topEdge := 15 ; drawMode := jam1 ; iTextFont := ADR(attr); iText := ADR("Konnte keine Liste erstellen"); nextText := NIL ; END ; (* WITH *) WITH meldung DO frontPen := 0 ; backPen := 1 ; leftEdge := 15 ; topEdge := 15 ; drawMode := jam1 ; iTextFont := ADR(attr); iText := ADR("Datei noch nicht gespeichert"); nextText := NIL ; END ; (* WITH *) WITH ende DO frontPen := 2 ; backPen := 3 ; leftEdge := 5 ; topEdge := 4 ; drawMode := jam1 ; iTextFont := ADR(attr); iText := ADR("ENDE") ; nextText := NIL ; END ; (* WITH *) WITH zurueck DO frontPen := 2 ; backPen := 3 ; leftEdge := 5 ; topEdge := 4 ; drawMode := jam1 ; iTextFont := ADR(attr); iText := ADR("Zurück") ; nextText := NIL ; END ; (* WITH *) WITH laden DO frontPen := 2 ; backPen := 3 ; leftEdge := 5 ; topEdge := 4 ; drawMode := jam1 ; iTextFont := ADR(attr); iText := ADR("Laden") ; nextText := NIL ; END ; (* WITH *) WITH eingabe DO frontPen := 2 ; backPen := 3 ; leftEdge := 5 ; topEdge := 4 ; drawMode := jam1 ; iTextFont := ADR(attr); iText := ADR("Eingabe") ; nextText := NIL ; END ; (* WITH *) WITH keineDat DO frontPen := 2 ; backPen := 3 ; leftEdge := 5 ; topEdge := 4 ; drawMode := jam1 ; iTextFont := ADR(attr); iText := ADR("Noch keine Datei vorhanden"); nextText := NIL ; END ; (* WITH *) WITH ok DO frontPen := 2 ; backPen := 3 ; leftEdge := 5 ; topEdge := 4 ; drawMode := jam1 ; iTextFont := ADR(attr); iText := ADR("OK") ; nextText := NIL ; END ; (* WITH *) FOR m := 0 TO 3 DO IF NOT CreateList(Kopf.Gruppe[m]) THEN fehler := AutoRequest(WPtr, ADR(liste), NIL, ADR(ende), IDCMPFlagSet{}, IDCMPFlagSet{}, 300, 65); HALT ; END ; (* IF *) END ; (* FOR *) WITH Kopf DO Name := "" ; Dir := "" ; Mod := v ; Anzahl := 0 ; gefragtV := 0 ; gewusstV := 0 ; gefragtU := 0 ; gewusstU := 0 ; END ; (* WITH *) fHandle := Open(ADR("env:VTrainer"), readOnly); IF fHandle # NIL THEN r := Read(fHandle, ADR(Kopf.Dir), 33); Close(fHandle); END; (* IF *) END Initialisieren ; PROCEDURE NeueListe(WPtr: WindowPtr) ; BEGIN FOR m := 0 TO 3 DO IF EntriesInList(Kopf.Gruppe[m]) # 0 THEN DeleteList(Kopf.Gruppe[m]) ; IF NOT CreateList(Kopf.Gruppe[m]) THEN fehler := AutoRequest(WPtr, ADR(liste), NIL, ADR(ende), IDCMPFlagSet{}, IDCMPFlagSet{}, 300, 65); HALT ; END ; (* IF NOT *); END ; (* IF Entries *) END ; (* FOR *) WITH Kopf DO Anzahl := 0 ; gefragtV := 0 ; gewusstV := 0 ; gefragtU := 0 ; gewusstU := 0 ; END ; (* WITH *) neu := TRUE ; END NeueListe ; PROCEDURE MenueAus ; BEGIN FOR m := 0 TO 2 DO OffMenu(WPtr, MakeNum(m, NoItem, NoSub)); END ; (* FOR *) END MenueAus ; PROCEDURE MenueAn ; VAR Msg : POINTER TO IntuiMessage ; BEGIN REPEAT Msg := GetMsg(WPtr^.userPort) ; IF Msg # NIL THEN ReplyMsg(Msg) ; END ; (* IF *) UNTIL Msg = NIL ; FOR m := 0 TO 2 DO OnMenu(WPtr, MakeNum(m, NoItem, NoSub)); END ; (* FOR *) END MenueAn ; BEGIN Initialisieren ; Assert(aslORarp, ADR("Weder Asl- noch ARP-Library konnte geöffnet werden!")); WPtr := Window(); myProc := CAST(ProcessPtr, FindTask(NIL)); (* Dos-Requester auf *) oldWin := CAST(WindowPtr, myProc^.windowPtr); (* den eigenen *) myProc^.windowPtr := WPtr; owin := TRUE; (* Screen umleiten *) Info(WPtr); LOOP WaitPort(WPtr^.userPort) ; IntuiMsg := GetMsg(WPtr^.userPort) ; WHILE IntuiMsg # NIL DO class := IntuiMsg^.class ; code := IntuiMsg^.code ; ReplyMsg(IntuiMsg) ; IF menuPick IN class THEN Auswertung(MNr, INr, SNr, code) ; IF MNr # MenuNull THEN CASE MNr OF 0 : IF INr # NoItem THEN CASE INr OF 0 : IF gespeichert THEN MenueAus ; NeueListe(WPtr) ; Lesen(Kopf, WPtr) ; neu := FALSE ; Stat(WPtr, Kopf); MenueAn ; ELSE IF AutoRequest(WPtr, ADR(meldung),ADR(laden), ADR(zurueck), IDCMPFlagSet{}, IDCMPFlagSet{}, 300, 65) THEN MenueAus ; NeueListe(WPtr) ; Lesen(Kopf, WPtr) ; neu := FALSE ; gespeichert := TRUE ; Stat(WPtr, Kopf); MenueAn ; END ; (* IF AutoRequest *) END | (* IF gespeichert *) 1 : MenueAus ; IF Kopf.Anzahl # 0 THEN IF Schreiben(Kopf, TRUE, WPtr) THEN neu := FALSE ; gespeichert := TRUE ; END ; (* IF Schreiben *) ELSE dummy := AutoRequest(WPtr, ADR(keineDat),NIL, ADR(ok), IDCMPFlagSet{}, IDCMPFlagSet{}, 300,65); END; (* IF Kopf *) MenueAn | 2 : MenueAus; IF Kopf.Anzahl # 0 THEN IF Schreiben(Kopf, neu, WPtr) THEN neu := FALSE ; gespeichert := TRUE ; END; (* IF Schreiben *) ELSE dummy := AutoRequest(WPtr, ADR(keineDat),NIL, ADR(ok), IDCMPFlagSet{}, IDCMPFlagSet{}, 300,65); END; (* IF Kopf *) MenueAn | 3 : MenueAus ; Hilfe(WPtr); MenueAn | 4 : Info(WPtr) | 5 : IF gespeichert THEN EXIT ; ELSE IF AutoRequest(WPtr, ADR(meldung), ADR(ende), ADR(zurueck), IDCMPFlagSet{}, IDCMPFlagSet{}, 300, 65) THEN EXIT ; END ; (* IF AutoRequest *) END| (* IF gespeichert *) ELSE; END ; (* CASE INr *) END | (* IF INr *) 1 : IF INr # NoItem THEN CASE INr OF 0 : IF SNr # NoSub THEN CASE SNr OF 0 : IF Kopf.Anzahl # 0 THEN MenueAus; IF Abfrage(WPtr, Kopf, v) THEN gespeichert := FALSE ; END ; (* IF Abfrage *) Stat(WPtr, Kopf); MenueAn ; ELSE dummy:=AutoRequest(WPtr,ADR(keineDat), NIL,ADR(ok),IDCMPFlagSet{}, IDCMPFlagSet{}, 300,65); END | (* IF Kopf *) 1 : IF Kopf.Anzahl # 0 THEN MenueAus; IF Abfrage(WPtr, Kopf, ue) THEN gespeichert := FALSE ; END ; (* IF Abfrage *) Stat(WPtr, Kopf); MenueAn ; ELSE dummy:=AutoRequest(WPtr,ADR(keineDat), NIL,ADR(ok),IDCMPFlagSet{}, IDCMPFlagSet{}, 300,65); END| (* IF Kopf *) ELSE; END ; (* CASE SNr *) END | (* IF SNr *) 1 : IF SNr # NoSub THEN CASE SNr OF 0 : MenueAus ; IF Eingabe(Kopf, WPtr) THEN gespeichert := FALSE ; END ; (* IF *) MenueAn | 1 : IF gespeichert THEN NeueListe(WPtr) ; MenueAus ; IF Eingabe(Kopf, WPtr) THEN gespeichert := FALSE ; END ; (* IF *) MenueAn ; ELSE IF AutoRequest(WPtr,ADR(meldung),ADR( eingabe), ADR(zurueck), IDCMPFlagSet{},IDCMPFlagSet{}, 300, 65) THEN NeueListe(WPtr) ; MenueAus ; IF Eingabe(Kopf, WPtr) THEN gespeichert := FALSE ; END ; (* IF Eingabe *) MenueAn ; END ; (* IF AutoRequest *) END| (* IF gespeichert *) ELSE; END ; (* CASE SNr *) END | (* IF SNr *) 2 : IF Kopf.Anzahl # 0 THEN MenueAus; Anzeige(WPtr, Kopf); MenueAn ; ELSE dummy := AutoRequest(WPtr, ADR(keineDat),NIL, ADR(ok), IDCMPFlagSet{}, IDCMPFlagSet{}, 300,65); END | (* IF *) 3 : IF Kopf.Anzahl # 0 THEN MenueAus; IF Ed(WPtr, Kopf) THEN gespeichert := FALSE ; END ; (* IF *) MenueAn ; ELSE dummy := AutoRequest(WPtr, ADR(keineDat),NIL, ADR(ok), IDCMPFlagSet{}, IDCMPFlagSet{}, 300,65); END | 4 : Stat(WPtr, Kopf)| ELSE; END ; (* CASE INr *) END | (* IF INr *) 2 : IF INr # NoItem THEN CASE INr OF 0 : MenueAus ; IF Kopf.Anzahl # 0 THEN Ausgabe(Kopf, WPtr); ELSE dummy := AutoRequest(WPtr, ADR(keineDat),NIL, ADR(ok), IDCMPFlagSet{}, IDCMPFlagSet{}, 300,65); END; (* IF Kopf *) MenueAn| (* Datei ausgeben *) ELSE; END ; (* CASE INr *) END| (* IF INr *) ELSE; END ; (* CASE MNr *) END ; (* IF MNr *) END ; (* IF menuPick *) IntuiMsg := GetMsg(WPtr^.userPort) ; END ; (* WHILE *) END ; (* LOOP *) CLOSE FOR m := 0 TO 3 DO IF EntriesInList(Kopf.Gruppe[m]) # 0 THEN DeleteList(Kopf.Gruppe[m]) ; END ; (* IF *) END ; (* FOR *) IF owin THEN (* Dos-Requester wieder auf die Workbench *) myProc^.windowPtr := oldWin; owin := FALSE; END; (* IF *) END VTrainer.